ETO Development Tools 4/ETO Development Tools 4.iso/Tools - Objects/MacApp/MacApp 3.0a2/Libraries/UDebug.inc1.p

Text File | 1991-05-01 | 89.8 KB | 3,659 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n+]}
{ UDebug.inc1.p }
{ Copyright © 1985-1989 by Apple Computer, Inc.  All rights reserved. }

USES
    {
    • List units defining any constants, types or classes that are required for your implementation
    section (e.g. Packages or Errors)
    • Also list units defining the classes that you declared EXTERNAL in the interface section
    or wish to use in the implementation section.
    • Also list the units required by the interfaces of the above units.
    }
    OSUtils, TextEdit, Memory, UMacAppUniversal, UPascalObject, UObject, UList, UStream, AppleEvents, UEvent, UCommand, UEvtHandler, Editions, Dialogs,
     UApplication, UDocument, Balloons,UAdorners, UView, UWindow, UFailure, UMacAppUtilities, UPatch, UMemory,
     UMacAppGlobals, UGeometry, UErrorMgr, Menus, UMenuMgr, Errors, ToolUtils, Packages, Fonts,
     Script, GestaltEqu, UTranscriptView, UInspector, Desk, DiskInit, Retrace, Resources,
     PasLibIntf, OSEvents, Perf, DisAsmLookUp, Notification, Processes, SysEqu, Devices, ULoMem;

{$IFC NOT qDebugTheDebugger}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$ENDC}
{$IFC qNames}
{$D+}
{$ENDC}

{$IFC UNDEFINED IncludeDisassembler}
{$SETC IncludeDisassembler := FALSE}                    { Don't automatically include in this
                                                         version }
{$ENDC}

CONST
    { Message types from the nub }
    kReadableText        = 'text';                        { Text from unknown source. Intended to
                                                         notify user }
    kRequestUserInput    = 'rui ';                        { Do whatever needs to be done to get user's
                                                         attn }
    kEnteredDebugger    = 'Dent';                        { The debugger nub was entered by the program }

    { Message types to the nub }
    kKeyStroke            = 'keys';                        { User keystroke in response to an inquiry }
    kEnterMacsBug        = 'EMac';                        { Have the nub enter macsbug }
    kExitToShell        = 'EShl';                        { Have the nub ExitToShell }
    kStatus             = 'Stat';
    kSetBreak            = 'SetB';
    kClearBreak         = 'ClrB';
    kDisplayMem         = 'DspM';
    kFieldsAsHex        = 'FldH';
    kGo                 = 'Go!!';
    kStepOver            = 'StpO';
    kStepInto            = 'StpI';
    kHeapCmd            = 'Heap';
    kInspect            = 'Insp';
    kLocals             = 'Lcls';
    kMore                = 'More';
    kParameters         = 'Parm';
    kPerfCommand        = 'Perf';
    kRecentPC            = 'Recn';
    kStack                = 'Stak';
    kSignalFailure        = 'Fail';
    kTrace                = 'Trce';
    kFlags                = 'Flag';
    kAllClasses         = 'AllC';
    kDisasm             = 'Disa';
    kMoreDisasm         = 'MDis';

    kHelpRequest        = '?';
    kDontKnow            = ' Huh? ';

    kReserve            = 500;                            { Heap space reserved for the debugger's
                                                         use. Too much?, Too little? }
    kRecent             = 63;                            { must be a power of 2 minus 1 }

    { 68000 exception numbers that we intercept }
    exBusError            = 2 * sizeof(Longint);
    exAddressError        = 3 * sizeof(Longint);
    exIllegalInst        = 4 * sizeof(Longint);
    exZeroDivide        = 5 * sizeof(Longint);
    exCheck             = 6 * sizeof(Longint);
    exOverflow            = 7 * sizeof(Longint);
    exLineF             = 11 * sizeof(Longint);

TYPE

    { Types for the Integrated environment interception calls }
    IEFilePath            = STRING;
    IEFilePathPtr        = ^IEFilePath;
    IEFRefNum            = Longint;


    {---}
    WhyInDebugger        = (tBegin, tEnd, tExit, tBeginEndPair, { the rest always stop }
                           tProgBreak, tSysError, tVBL, tReadLn);
    ProcPtrPtr            = ^ProcPtr;

    HexAddress            = STRING[16];                    { Usually 8-9 chars. Sometimes a _small_
                                                         string constant though. }

    QElemWithA5         = RECORD
        OldA5:                Longint;                    { A place to store the old value of A5 since
                                                         when debugging the compiler trashes the
                                                         value of A0 for any locals in the VBL task
                                                         thus makeing the pointer to the
                                                         paramblockrec unavailable }
        A5:                 Longint;                    { The value of A5 will be stored here to be
                                                         available at VBL time }
        q:                    QElem;                        { vbl queue element for changing the cursor}
        END;

    VBLInfoPtr            = ^VBLInfo;
    VBLInfo             = RECORD
        aQElemWithA5:        QElemWithA5;                { vbl queue element for changing the cursor
                                                         }
        ch:                 CHAR;                        { character to represent the flag to the
                                                         user with }
        actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
                                                         action is required when setting flag }
        desc:                StringHandle;                { a description of the flag's function }
        END;

    DebugFEntry         = RECORD
        addr:                BooleanPtr;                 { Pointer to the actual boolean used for the
                                                         flag }
        ch:                 CHAR;                        { character to represent the flag to the
                                                         user with }
        actionProc:         ProcPtr;                    { Pointer to a Proc that takes a boolean. If
                                                         action is required when setting flag }
        desc:                StringHandle;                { a description of the flag's function }
        END;

    DebugSEntry         = RECORD
        addr:                Ptr;
        actionProc:         ProcPtr;                    { Pointer to a Function that returns a Ptr.
                                                         If action is required to get addr (pass
                                                         nil for addr) }
        sym:                MAName;
        END;

    RecentPC            = RECORD
        thePC:                Longint;
        theWhyInDebugger:    WhyInDebugger;
        END;

    HideType            = (PartialHide, FullHide);

VAR
{$Push} {$J+}
    pUDebugInitialized: BOOLEAN;
    pCanEnterDebugger:    BOOLEAN;
    pFileName:            Str255;                         { Name of file to intercept for IO }

{$Pop}

    pDisciplineMethodCalls: BOOLEAN;

    pVBLInfo:            VBLInfo;

    pTraceToggle, pTraceEnabled: BOOLEAN;
    pBreakCount:        INTEGER;                        { current number of breakpoints set }
    pBreakClass, pBreakProc: ARRAY [1..10] OF MAName;
    pStackSpace:        Longint;                        { current total stack space; set in %_BP }
    pProcStack:         Longint;                        { current stack space for just last
                                                         procedure to do a %_BP }
    pBreakStack:        Longint;
    pStepOverStackSize: Longint;                        { when stepping the stack to break on if
                                                         same or less }
    pBrProcStack:        Longint;
    pReserve:            Handle;

    pInterceptExceptionVectors: BOOLEAN;                { whether to intercept the 68xxx lo-memory
                                                         exception vectors }
    pOldexBusError, pOldexAddressError, pOldexIllegalInst, pOldexZeroDivide, pOldexCheck,
    pOldexOverflow, pOldexLineF: ProcPtr;                { The old exception vectors }

    pSysErrPatch:        TrapPatch;

    pMoreMem:            Longint;                        {-1 if no more to see; 0 if more stack trace
                                                         possible, else more memory dump}
    pRecentPC:            ARRAY [0..kRecent] OF RecentPC; { PC ring buffer }
    pRecentIndex:        INTEGER;

    pMasters:            INTEGER;                        { # available master pointers found by
                                                         latest %_BP or %_EP }
    pEnterProc:         Ptr;
    pSymbolProc:        Ptr;

    pFlagTable:         TDynamicArray;                    { list of DebugFEntry records }
    pSymTable:            TDynamicArray;                    { list of symbol table records }

    pPermFlag:            BOOLEAN;

    pTP2PerfGlobals:    TP2PerfGlobals;                 { Pointer to performance globals record
                                                         Non-nil if tools are inited }

    fCaptureProc:        ProcPtr;                        { procedure for capturing output; set it
                                                         with DebugCapture }

    pFullyHiddenFromMacApp: BOOLEAN;                    { Are we stopped in the read loop }
    pQHdr:                QHdr;                            { Saved Event Queue Header }
    pQSize:             INTEGER;                        { number of events }

    discardStr:         MAName;                         { a string that is used as a placeholder in
                                                         any calls where rqd but the result is not
                                                         rqd. Helps to reduce stack requirements }

    { the following were locals to MADebuggerMainEntry but… since the debugger is not re-entrant (for now) they can be
    globals and thus available to the procedures that were nested in MADebuggerMainEntry but are no longer.
    Also we knock off about 2k of stack requirements. }
    gWhyInDebugger:     WhyInDebugger;
    pLink:                Longint;
    ppc:                Longint;
    aClassName:         MAName;
    aProcName:            MAName;
    aMiscName:            MAName;
    asDecimal, asHex:    Longint;
    pAtBreak:            BOOLEAN;
    callerFrame:        Longint;
    ch:                 CHAR;
    className:            MAName;
    itsFrame:            Longint;
    nextFrame:            Longint;
    nextLevel:            INTEGER;
{$Ifc qPerform}
    oldState:            BOOLEAN;                        { State of Performance monitoring when
                                                         enterproc called and the state to which
                                                         monitering will return. Performance
                                                         monitering toggle changes this value }
{$Endc}
    pNextPC:            Longint;
    prevFrame:            Longint;
    procName:            MAName;
    rcvrClass:            MAName;
    rcvrHandle:         HexAddress;
    receiver:            TObject;
    segNum:             INTEGER;
    stkBreak:            BOOLEAN;
    stepBreak:            BOOLEAN;
    str:                MAName;
    pStoppedInDebugger: BOOLEAN;
    lastCH:             CHAR;

    theDebuggerAddress: AEAddressDesc;
    pHasDebuggerAddress: BOOLEAN;
{--------------------------------------------------------------------------------------------------}
{$Ifc qPerform}
{$S MADebugger}

FUNCTION DebugPerfMonitor(turnOn: BOOLEAN): BOOLEAN;
{ Turns performance tracing on and off if installed. }

    BEGIN
    IF (pTP2PerfGlobals <> NIL) & pUDebugInitialized THEN
        DebugPerfMonitor := PerfControl(pTP2PerfGlobals, turnOn)
    ELSE
        DebugPerfMonitor := FALSE;
    END;
{$Endc}

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
FUNCTION _addDevHandler(slot, dvName, dvFAccess, dvClose, dvRead, dvWrite,
                        dvIoctl: Longint): Longint;
    C; EXTERNAL;

{--------------------------------------------------------------------------------------------------}
{ The following are assembler routines in UDebug.a }

PROCEDURE XDebugSysError;
    EXTERNAL;
{ PROCEDURE XDebugNMI;    EXTERNAL; }

PROCEDURE XDebugBusError;
    EXTERNAL;

PROCEDURE XDebugAddrError;
    EXTERNAL;

PROCEDURE XDebugIllInst;
    EXTERNAL;

PROCEDURE XDebugZeroDiv;
    EXTERNAL;

PROCEDURE XDebugCheck;
    EXTERNAL;

PROCEDURE XDebugOverflow;
    EXTERNAL;

PROCEDURE XDebugLineF;
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}
PROCEDURE VBLInstall;
    FORWARD;

PROCEDURE VBLRemove;
    FORWARD;

PROCEDURE NubWaitNextEvent;
    FORWARD;

FUNCTION DebuggerDispatch(message, reply: AppleEvent; info: Longint): OSErr;
    FORWARD;

{--------------------------------------------------------------------------------------------------}
{ The following are assembler routines in UDebug.cp }

FUNCTION IsFrontProcess: Boolean;
    EXTERNAL;

FUNCTION DevFAccess(fName: UNIV IEFilePathPtr; opCode: Longint; arg: UNIV Longint): Longint;
    C; EXTERNAL;

FUNCTION DevClose(fdesc: IEFRefNum): Longint;
    C; EXTERNAL;

FUNCTION DevRead(fdesc: IEFRefNum; bufp: UNIV Longint; count: Longint): Longint;
    C; EXTERNAL;

FUNCTION DevWrite(fdesc: IEFRefNum; bufp: UNIV Longint; count: Longint): Longint;
    C; EXTERNAL;

FUNCTION DevIoctl(fdesc: IEFRefNum; request: Longint; arg: UNIV Longint): Longint;
    C; EXTERNAL;

FUNCTION SetGetProc(theGetProc: ProcPtr): ProcPtr;
    EXTERNAL;

FUNCTION SetPutProc(thePutProc: ProcPtr): ProcPtr;
    EXTERNAL;

{--------------------------------------------------------------------------------------------------}

FUNCTION CallSymActionProc(actionProc: ProcPtr): Handle;
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

FUNCTION CallSymbolLookup(VAR sym: Str255; lookerUpper: Ptr): Longint;
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

PROCEDURE CallInspector(obj: TObject; inspector: Ptr);
    INLINE $205F, $4E90;
{ MOVE.L (A7)+,A0
JSR (A0)
}

FUNCTION CallFlagActionProc(OnOrOff: BOOLEAN; actionProc: ProcPtr): BOOLEAN;
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

PROCEDURE CallEnter(entering: BOOLEAN; proc: Ptr);
    INLINE $205F, $4E90;
{  MOVE.L  (A7)+,A0
JSR (A0)
}

PROCEDURE CallCapture(textBuf: Ptr; byteCount: Longint; captureProc: ProcPtr);
    INLINE $205F, $4E90;
{ MOVEA.L (A7)+,A0
JSR (A0)
}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION NubGetDebuggerAddress: AEAddressDesc;

    VAR
        theTargetID:        TargetID;
        theLoc:             LocationNameRec;
        thePortInfo:        PortInfoRec;
        theErr:             OSErr;

        theMessage:         AEDesc;
        theReply:            AEDesc;

    BEGIN
    { Get a debugger address if necessary }
    IF NOT pHasDebuggerAddress THEN
        BEGIN
        theErr := PPCBrowser('Please find the debugger', '', FALSE, theLoc, thePortInfo, NIL, '');
        IF theErr = NoErr THEN
            BEGIN
            theTargetID.location := theLoc;
            theTargetID.name := thePortInfo.name;

            FailOSErr(AECreateDesc(typeTargetID, @theTargetID, sizeof(TargetID),
                      theDebuggerAddress));
            pHasDebuggerAddress := TRUE;
            NubGetDebuggerAddress := theDebuggerAddress;
            END
        ELSE
            BEGIN
            DebugStr('couldn''t find MacApp debugger');
            ExitToShell;                                { Cancelled??? }
            END;
        END
    ELSE
        NubGetDebuggerAddress := theDebuggerAddress;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION YouAreWarned: BOOLEAN;
{ Returns true if the super secret power keys are held down.
Used to indicate to the debugger that the programmer wants to flirt with _DANGER_!
If you do this then you're _ON_YOUR_OWN. }

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN
    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;
    IF aKeyMap[$3B] THEN                                { Control key }
        YouAreWarned := TRUE
    ELSE
        YouAreWarned := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE SaveEventQueue(save: BOOLEAN);

    CONST
        kLMEvtBufCnt        = $154;

    BEGIN
    IF save THEN
        BEGIN
        { Save the existing event queue }
        pQHdr := GetEvQHdr^;
        WITH GetEvQHdr^ DO
            BEGIN
            qFlags := 0;
            qHead := NIL;
            qTail := NIL;
            END;
        pQSize := IntegerPtr(kLMEvtBufCnt)^;
        END
    ELSE
        BEGIN
        { Restore the event queue }
        {    FlushEvents(everyEvent, 0); }
        GetEvQHdr^ := pQHdr;
        IntegerPtr(kLMEvtBufCnt)^ := pQSize;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE WithHideFromMacAppDo(PROCEDURE WhatToDo; itsHideType: HideType);
{
Intended for doit behind MacApp's back stuff.
Fullhide indicates whether to give enough support to fully stop in the debugger
}

    VAR
        oldpCanEnterDebugger: BOOLEAN;

        oldpFullyHiddenFromMacApp: BOOLEAN;
        OldA5: Longint;
        oldResLoad: BOOLEAN;
        oldResFile: INTEGER;
        fi: FailInfo;

    PROCEDURE UnloadActivateEvents;
    { Activate events are manufactured by the window manager
    Thus they need to be preserved. The activate event if any
    is retrieved then the procedure recursed to get any more.  Then
    the events are reposted on the application event queue. }

        VAR
            theEvent: EventRecord;
            aEvQElPtr: EvQElPtr;

        BEGIN
        IF GetNextEvent(activMask, theEvent) THEN
            BEGIN
            UnloadActivateEvents; { recurse to get more }
            WITH theEvent DO
                BEGIN
                IF (PPostEvent(activateEvt, message, aEvQElPtr)) = NoErr THEN
                    aEvQElPtr^.evtQmodifiers := modifiers;
                END;
            END;
        END;

    PROCEDURE HdlFailure(error: INTEGER; message: Longint);

        BEGIN
        pCanEnterDebugger := oldpCanEnterDebugger;
        pFullyHiddenFromMacApp := FALSE;

        IF MAUseResFile(oldResFile) = 0 THEN;
        SetResLoad(oldResLoad);
        OldA5 := SetA5(OldA5);
        {###        SaveEventQueue(FALSE);}

        CallEnter(FALSE, pEnterProc);
        pCanEnterDebugger := TRUE;
        END;

    BEGIN
    oldpFullyHiddenFromMacApp := pFullyHiddenFromMacApp;
    oldpCanEnterDebugger := pCanEnterDebugger;

    OldA5 := SetCurrentA5;
    oldResLoad := GetResLoad;
    SetResLoad(TRUE);
    oldResFile := MAUseResFile(gApplicationRefNum);
{###        UnloadActivateEvents;
        SaveEventQueue(true);}

    IF NOT oldpFullyHiddenFromMacApp THEN
        CASE itsHideType OF
            PartialHide:
                pCanEnterDebugger := FALSE;

            FullHide:
                BEGIN
                pCanEnterDebugger := FALSE;
                pFullyHiddenFromMacApp := TRUE;

                END; { FullHide }
        END; { CASE }

    CatchFailures(fi, HdlFailure);

    WhatToDo;

    Success(fi);

    pCanEnterDebugger := oldpCanEnterDebugger;
    pFullyHiddenFromMacApp := FALSE;

    IF MAUseResFile(oldResFile) = 0 THEN;
    SetResLoad(oldResLoad);
    OldA5 := SetA5(OldA5);
    {###        SaveEventQueue(FALSE);}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugReadCh: CHAR;

    VAR
        C:                    CHAR;
        theMessage:         AEDesc;
        theReply:            AEDesc;

    BEGIN
    { guarantee that user can see prompts }
    PLflush(output);

    { Create the basic message to send }
    FailOSErr(AECreateAppleEvent('MADB', kRequestUserInput, NubGetDebuggerAddress,
                                 kAutoGenerateReturnID, kAnyTransactionID, theMessage));

    { Send it off, and don't worry about a reply or receipt }
    FailOSErr(AESend(theMessage, theReply, kAENoReply, kAENormalPriority, 1000, NIL, NIL));

    FailOSErr(AEDisposeDesc(theMessage));

    WHILE (lastCH = chr(0)) DO
        NubWaitNextEvent;

    DebugReadCh := lastCH;
    lastCH := chr(0);
    END;

{$EndC}
{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugReadLn(buffer: Ptr; byteCount: Longint): Longint;

    TYPE
        PA1000                = PACKED ARRAY [0..999] OF CHAR;
        StrPtr                = ^PA1000;

    VAR
        ch:                 CHAR;
        len:                INTEGER;

    PROCEDURE WhatToDo;

        BEGIN
        len := 0;

        REPEAT
            ch := DebugReadCh;

            CASE ch OF
                chBackspace:
                    IF len > 0 THEN
                        BEGIN
                        Write(ch);
                        len := len - 1;
                        StrPtr(buffer)^[len] := ' ';
                        END;
                OTHERWISE
                    BEGIN
                    Write(ch);
                    StrPtr(buffer)^[len] := ch;
                    len := len + 1;
                    END
            END;
        UNTIL (ch = chReturn) | (len = byteCount);

        DebugReadLn := len;
        END;

    BEGIN
    IF FALSE & NOT pFullyHiddenFromMacApp THEN
        BEGIN
        gWhyInDebugger := tReadLn;
        END;

    WithHideFromMacAppDo(WhatToDo, FullHide);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE InstallExceptionHandlers(install: BOOLEAN);

    BEGIN

    IF install THEN
        BEGIN
        { Intercept 68000 exceptions }
        IF pInterceptExceptionVectors THEN
            BEGIN
            pOldexBusError := ProcPtrPtr(exBusError)^;
            ProcPtrPtr(exBusError)^ := @XDebugBusError;

            pOldexAddressError := ProcPtrPtr(exAddressError)^;
            ProcPtrPtr(exAddressError)^ := @XDebugAddrError;

            pOldexIllegalInst := ProcPtrPtr(exIllegalInst)^;
            ProcPtrPtr(exIllegalInst)^ := @XDebugIllInst;

            pOldexZeroDivide := ProcPtrPtr(exZeroDivide)^;
            ProcPtrPtr(exZeroDivide)^ := @XDebugZeroDiv;

            pOldexCheck := ProcPtrPtr(exCheck)^;
            ProcPtrPtr(exCheck)^ := @XDebugCheck;

            pOldexOverflow := ProcPtrPtr(exOverflow)^;
            ProcPtrPtr(exOverflow)^ := @XDebugOverflow;

            pOldexLineF := ProcPtrPtr(exLineF)^;
            ProcPtrPtr(exLineF)^ := @XDebugLineF;
            END;

        { Intercept SysError calls }
        FailOSErr(PatchTrap(pSysErrPatch, _SysError, @XDebugSysError));
        END
    ELSE
        BEGIN
        { UN-Intercept 68000 exceptions }
        IF pInterceptExceptionVectors THEN
            BEGIN
            IF ProcPtrPtr(exBusError)^ = @XDebugBusError THEN
                ProcPtrPtr(exBusError)^ := pOldexBusError;

            IF ProcPtrPtr(exAddressError)^ = @XDebugAddrError THEN
                ProcPtrPtr(exAddressError)^ := pOldexAddressError;

            IF ProcPtrPtr(exIllegalInst)^ = @XDebugIllInst THEN
                ProcPtrPtr(exIllegalInst)^ := pOldexIllegalInst;

            IF ProcPtrPtr(exZeroDivide)^ = @XDebugZeroDiv THEN
                ProcPtrPtr(exZeroDivide)^ := pOldexZeroDivide;

            IF ProcPtrPtr(exCheck)^ = @XDebugCheck THEN
                ProcPtrPtr(exCheck)^ := pOldexCheck;

            IF ProcPtrPtr(exOverflow)^ = @XDebugOverflow THEN
                ProcPtrPtr(exOverflow)^ := pOldexOverflow;

            IF ProcPtrPtr(exLineF)^ = @XDebugLineF THEN
                ProcPtrPtr(exLineF)^ := pOldexLineF;
            END;

        { UN-Intercept SysError calls }
        UnpatchTrap(pSysErrPatch);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE JTOffProc(A5JTOffset: UNIV INTEGER; VAR s: UNIV Str255 {DisAsmStr80});

    CONST
        kUnloaded            = $3F3C;

    VAR
        aName:                MAName;
        pc:                 Longint;

    BEGIN
    pc := Longint(GetA5) + A5JTOffset;
    IF IntegerPtr(pc)^ <> kUnloaded THEN
        BEGIN
        GetMethodName(ord(@pc), aName);
        s := aName;
        END
    ELSE
        s := '';
    END;

{$EndC}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION IsUserBreak: BOOLEAN;

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN
    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;
    IsUserBreak := aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & (NOT qDebug | pUDebugInitialized);
    END;

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE stdHelpProc;

    BEGIN
    WriteLn;
    WriteLn('Reply with one of the letters in the brackets');
    WriteLn;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedChar(prompt: StringPtr; validChars: StringPtr; PROCEDURE helpProc): CHAR;

    VAR
        ch:                 CHAR;
        done:                BOOLEAN;
        index:                INTEGER;

    PROCEDURE WriteThePrompt;

        BEGIN
        Write(prompt^); Write(' ['); Write(validChars^); Write(kHelpRequest);
        Write(']: ');
        END;

    BEGIN
    WriteThePrompt;
    REPEAT
        ch := UprChar(DebugReadCh);
        CASE ch OF
            kHelpRequest, chHelp:
                BEGIN
                helpProc;
                WriteThePrompt;
                done := FALSE
                END;
            chReturn:
                BEGIN
                WriteLn;
                done := TRUE;
                END;
            OTHERWISE
                BEGIN
                FOR index := 1 TO length(validChars^) DO
                    IF ch = UprChar(validChars^[index]) THEN
                        BEGIN
                        WriteLn(ch);
                        done := TRUE;
                        LEAVE;
                        END;
                IF index > length(validChars^) THEN
{###SRF                    gApplication.Beep(30);    };            { 1/2 second }
                END;
        END;
    UNTIL done;
    GetPromptedChar := ch;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedString(prompt: StringPtr; PROCEDURE helpProc): Str255;

    VAR
        returnStr:            Str255;
        done:                BOOLEAN;

    BEGIN
    Write(prompt^);
    returnStr := '';
    REPEAT
        ch := DebugReadCh;
        CASE ch OF
            chHelp:
                BEGIN
                WriteLn;
                helpProc;
                Write(prompt^);
                done := FALSE
                END;
            chBackspace:
                BEGIN
                IF length(returnStr) > 0 THEN
                    BEGIN
                    Write(ch);
                    returnStr[0] := chr(max(length(returnStr) - 1, 0));
                    END;
                done := FALSE
                END;
            chReturn:
                BEGIN
                Write(ch);
                IF returnStr = kHelpRequest THEN
                    BEGIN
                    returnStr := '';
                    helpProc;
                    Write(prompt^);
                    done := FALSE
                    END
                ELSE
                    done := TRUE;
                END;
            OTHERWISE
                BEGIN
                Write(ch);
                returnStr := concat(returnStr, ch);
                done := FALSE;
                END;
        END;
    UNTIL done;
    GetPromptedString := returnStr;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetFreeMastersCount: Longint;

    VAR
        zone:                THZ;
        pL:                 LongIntPtr;
        mpCnt:                Longint;

    BEGIN
    zone := ApplicZone;
    pL := LongIntPtr(zone^.hFstFree);
    mpCnt := 0;
    WHILE pL <> NIL DO
        BEGIN
        mpCnt := mpCnt + 1;
        pL := LongIntPtr(pL^);
        END;
    GetFreeMastersCount := mpCnt;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE CheckFreeMasters;

    VAR
        mp:                 Longint;

    BEGIN
    IF pMasters > 0 THEN                                { we computed # masters before }
        BEGIN
        mp := GetFreeMastersCount;
        IF pMasters <> mp THEN
            BEGIN
            WriteLn('pMasters: ', pMasters, '  current masters: ', mp);
            IF gMemMgtBreak THEN
                gSingleStep := TRUE;
            END;
        END;

    pMasters := GetFreeMastersCount
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugWriteLnHook(textBuf: Ptr; byteCount: Longint);

    PROCEDURE WhatToDo;

        VAR
            theMessage:         AEDesc;
            theReply:            AEDesc;

        BEGIN
        IF fCaptureProc <> NIL THEN
            CallCapture(textBuf, byteCount, fCaptureProc);

        { Create the basic message to send }
        FailOSErr(AECreateAppleEvent('MADB', kReadableText, NubGetDebuggerAddress,
                                     kAutoGenerateReturnID, kAnyTransactionID, theMessage));

        { Put the pointer data in as direct parameter… }
        FailOSErr(AEPutParamPtr(theMessage, keyDirectObject, 'data', textBuf, byteCount));

        { Send it off, and don't worry about a reply or receipt }
        FailOSErr(AESend(theMessage, theReply, kAENoReply, kAENormalPriority, 1000, NIL, NIL));

        FailOSErr(AEDisposeDesc(theMessage));
        END;

    BEGIN
    WithHideFromMacAppDo(WhatToDo, PartialHide);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE InstallWriteLnHook;

    CONST
        kConsoleName        = 'dev:console';
        _CODEV                = 1;                        { console device number }

    VAR
        slot:                Longint;
        oldProc:            ProcPtr;

    BEGIN
    pFileName := kConsoleName;
    slot := _addDevHandler(_CODEV, 0, ord(@DevFAccess), ord(@DevClose), ord(@DevRead),
                           ord(@DevWrite), ord(@DevIoctl));
    PLsetvbuf(output, NIL, _IOLBF, 128);
    oldProc := SetGetProc(@DebugReadLn);
    oldProc := SetPutProc(@DebugWriteLnHook);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAInit}

PROCEDURE InitUDebug(segTable, nonRes: Handle; enterProc, symbolProc: Ptr);
{ essential initialization (segTable, nonRes left in for compatibility (2.0) }

    CONST
        kDebugHeight        = 100;
        kVMargin            = 4;
        kHMargin            = 4;

    TYPE
        dbugParams            = RECORD                    { Format of 'dbug' resource }
            boundsRect:         Rect;                    { Rect of debugging window }
            fontNumber:         INTEGER;                { Font rsrc ID }
            fontSize:            INTEGER;                { Font size }
            numLines:            INTEGER;                { Number of lines }
            lineWidth:            INTEGER;                { Line width }
            openInitially:        BOOLEAN;                { Open Initially }
            title:                Str255;                 { Actually, variable length }
            END;
        dbugParamsPtr        = ^dbugParams;
        dbugParamsHandle    = ^dbugParamsPtr;

    VAR
        wasTrcEnable:        BOOLEAN;
        dParams:            Handle;

        addr:                Longint;
        i:                    INTEGER;
        err:                OSErr;
        vhs:                VHSelect;
        zoomedOutSize:        Point;
        aDebugParams:        dbugParams;
        aTextStyle:         TextStyle;
        Errs:                Handle;

    BEGIN
    pFullyHiddenFromMacApp := FALSE;
    pCanEnterDebugger := FALSE;
    pDisciplineMethodCalls := TRUE;                     { matches default in uobject }
    pHasDebuggerAddress := FALSE;

    pInterceptExceptionVectors := TRUE;

    pTP2PerfGlobals := NIL;

    lastCH := chr(0);

    pTraceToggle := FALSE;
    gSingleStep := FALSE;
    pBreakCount := 0;
    pTraceEnabled := FALSE;
    gTracing := FALSE;
    gReportNext := FALSE;
    gReportInfo := '';
    gReportTime := FALSE;

    pMasters := - 1;

    New(pFlagTable);
    pFlagTable.IDynamicArray(0, sizeof(DebugFEntry));

    New(pSymTable);
    pSymTable.IDynamicArray(0, sizeof(DebugSEntry));

    gMaxStackDepth := - 1;
    pBreakStack := $7FFFFFFF;
    pStepOverStackSize := 0;
    pBrProcStack := $7FFFFFFF;
    gMaxLockedRsrc := 0;

    pEnterProc := enterProc;
    pSymbolProc := symbolProc;

    FOR i := 0 TO kRecent DO
        BEGIN
        pRecentPC[i].thePC := 0;
        pRecentPC[i].theWhyInDebugger := tSysError;
        END;
    pRecentIndex := 0;

    fCaptureProc := NIL;
    pReserve := NewPermHandle(kReserve);                { Reserve some space in case of SysErr }
    FailNil(pReserve);

{###SRF    InstallExceptionHandlers(TRUE);}

{$IFC IncludeDisassembler}
    { Init Ira's disassembler }
    InitLookup(NIL, @JTOffProc, @LookupTrapName, NIL, NIL);
{$EndC}

    VBLInstall;

{### need to use accessors now that these are fields
    DebugGlobalHandle(@pSavedState.fTarget, NIL, AtMAName('fTarget'));
    DebugGlobalHandle(@gDocList, NIL, AtMAName('gDocList'));
    DebugGlobalHandle(@gFreeWindowList, NIL, AtMAName('gFreeWindowList'));
    DebugGlobalHandle(@gApplication.fClipView, NIL, AtMAName('fClipView'));
    DebugGlobalHandle(@gApplication.fClipUndoView, NIL, AtMAName('fClipUndoView'));

    DebugGlobalHandle(@gPrintHandler, NIL, AtMAName('gPrintHandler'));
    DebugGlobalHandle(@gFocusedView, NIL, AtMAName('gFocusedView'));

    DebugGlobalHandle(NIL, @DebugGetLastCommand, AtMAName('GetLastCommand'));
    DebugGlobalHandle(NIL, @DebugGetActiveWindow, AtMAName('GetActiveWindow'));
    DebugGlobalHandle(NIL, @DebugGetActiveDocument, AtMAName('GetActiveDocument'));
}

    DebugFlag(@gIntenseDebugging, 'I', NIL, AtStr('Intense debugging'));
    DebugFlag(@gShowInvalidations, 'L', NIL, AtStr('Show Invalidations'));
    DebugFlag(@gShowCursorRegion, 'K', NIL, AtStr('Show Cursor Region'));
    DebugFlag(@gShowHelpRegion, 'H', NIL, AtStr('Show Help Region'));
    DebugFlag(@gShowSleepRegion, 'W', NIL, AtStr('Show Sleep Region'));
    DebugFlag(@gMemMgtBreak, 'B', NIL, AtStr('Memory management break'));
    DebugFlag(@gMastReport, 'M', NIL, AtStr('Report # masters'));
    DebugFlag(@gSegReport, 'S', NIL, AtStr('Report segment load'));
    DebugFlag(@gUnloadAllSegs, 'U', NIL, AtStr('Unload segments'));
    DebugFlag(@gExperimenting, 'X', NIL, AtStr('Experimenting'));
    DebugFlag(@gAskFailure, 'F', NIL, AtStr('Ask about failures'));
    DebugFlag(@gReportEvt, 'E', NIL, AtStr('Report events'));
    DebugFlag(@gAskAboutAlloc, 'A', NIL, AtStr('Ask about allocations'));
    DebugFlag(@gRsrcReport, 'R', NIL, AtStr('Report resource usage'));
    DebugFlag(@gReportMenuChoices, 'C', NIL, AtStr('Report menu commands'));
    DebugFlag(@gDebugPrinting, 'P', NIL, AtStr('Printing debug'));
    DebugFlag(@pDisciplineMethodCalls, 'D', @DisciplineMethodCalls,
              AtStr('Discipline method calls'));
    DebugFlag(@gAssumeFocused, 'V', NIL, AtStr('Do "AssumeFocused" preconditioning'));

{$IFC qExperimentalAndUnsupported}
    DebugFlag(@gEnableDoubleBuffering, 'G', NIL, AtStr('Enable double buffering of views'));
{$EndC}

    {### Move err strings out of nub }
    { Make sure the error strings are always available by loading them and but not
    letting them be purgeable }
    Errs := GetResource('STR#', 252);
    FailNILResource(Errs);
    HNoPurge(Errs);

    { take all debugger events }
    FailOSErr(AEInstallEventHandler('MADB', typeWildCard, @DebuggerDispatch, cNoCommand, FALSE));

    { LAST THING ON INIT: install the console interceptor }
    InstallWriteLnHook;

    pUDebugInitialized := TRUE;
    pCanEnterDebugger := TRUE;

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugTerminate;

    BEGIN
    IF pUDebugInitialized THEN
        BEGIN
        VBLRemove;

{$IFC qPerform}
        { Make sure the performance tools are shut down if they are initialized }
        IF pTP2PerfGlobals <> NIL THEN
            BEGIN
            TermPerf(pTP2PerfGlobals);
            pTP2PerfGlobals := NIL;
            END;
{$ENDC}

        InstallExceptionHandlers(FALSE);

        { Guarantee we can't be re-entered }
        pUDebugInitialized := FALSE;
        pCanEnterDebugger := FALSE;

        END;
    END;
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugFlag(flagAddr: BooleanPtr; flagChar: CHAR; theActionProc: ProcPtr; {CONST}
                    flagDesc: StringPtr);
{ Register a BOOLEAN flag for the X debugger command;
flagAddr should be the address of the flag;
theActionProc should be a procPtr for a proc to be called to change the flag (optional).
flagChar should be the character to use in the debugger to toggle the flag;
desc should be a short description of the flag.
No checking is done for duplicate flagChars. }

    VAR
        theCount:            INTEGER;
        aDebugFEntry:        DebugFEntry;

    BEGIN
    WITH aDebugFEntry DO
        BEGIN
        addr := flagAddr;
        ch := UprChar(flagChar);
        actionProc := theActionProc;
        desc := NewString(flagDesc^);
        FailNil(desc);
        END;
    pFlagTable.InsertElementsBefore(pFlagTable.GetSize + 1, @aDebugFEntry, 1);
    END;
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugGlobalHandle(globAddr: Ptr; theActionProc: ProcPtr; {CONST}
                            globSym: MANamePtr);
{ Register a symbol name of a global variable that contains a handle;
Case does not matter.  The global variable should contain a Handle.
The Action proc is a Function to be called to derive the handle if necessary. }

    VAR
        aDebugSEntry:        DebugSEntry;

    BEGIN
    WITH aDebugSEntry DO
        BEGIN
        addr := globAddr;
        actionProc := theActionProc;
        sym := globSym^;
        END;
    pSymTable.InsertElementsBefore(pSymTable.GetSize + 1, @aDebugSEntry, 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNames(prompt: StringPtr; VAR className, procName: MAName): BOOLEAN;

    VAR
        ch:                 CHAR;
        len:                INTEGER;
        s:                    Str255;
        i:                    INTEGER;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('Please supply a ClassName.MethodName or MethodName or ProcName');
        WriteLn;
        END;

    BEGIN
    GetPromptedNames := FALSE;

    className := '';
    procName := '';
    len := 0;

    s := GetPromptedString(prompt, helpProc);

    FOR i := 1 TO length(s) DO
        BEGIN
        ch := UprChar(s[i]);

        IF ch IN ['A'..'Z', '0'..'9', '_', '%'] THEN
            BEGIN
            GetPromptedNames := TRUE;
            len := len + 1;
            procName[len] := ch;
            procName[0] := chr(len);
            END
        ELSE IF ch = '.' THEN
            BEGIN
            className := procName;
            procName := '';
            len := 0;
            END
        ELSE IF ch <> ' ' THEN
            BEGIN
            GetPromptedNames := FALSE;
            WriteLn(kDontKnow);
            Exit(GetPromptedNames);
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedValue(prompt: StringPtr; VAR asDecimal, asHex: Longint; symbolOK: BOOLEAN;
                          VAR gotSymbol: BOOLEAN): BOOLEAN;
 { returns TRUE iff a valid number is typed;
  if it returns FALSE but the parameters are 0, then the user typed only a return;

  if symbolOK is TRUE then a symbol is allowed, and gotSymbol will indicate if
  a symbol was typed }

    VAR
        ch:                 CHAR;
        digit:                INTEGER;
        anEvent:            EventRecord;
        s:                    Str255;
        i:                    INTEGER;
        sym:                Str255;
        done:                BOOLEAN;
        symbolTableSym:     Str255;
        gotNegation:        BOOLEAN;

    PROCEDURE helpProc;

        VAR
            i:                    INTEGER;

        FUNCTION DoSym(index: ArrayIndex): BOOLEAN;

            VAR
                aDebugSEntry:        DebugSEntry;

            BEGIN
            pSymTable.GetElementsAt(index, @aDebugSEntry, 1);
            Write(aDebugSEntry.sym, ' ');
            DoSym := FALSE;
            END;

        BEGIN
        WriteLn;
        Write('Please supply a valid number');
        IF NOT symbolOK THEN
            WriteLn('.')
        ELSE
            BEGIN
            Write(' or one of the following symbols:');
            sym := kHelpRequest;
            asDecimal := CallSymbolLookup(sym, pSymbolProc);
            WriteLn;

            IF pSymTable.EachElementDoTil(DoSym, kIterateForward) = 0 THEN;
            WriteLn;
            END;
        END;

    FUNCTION DoSymSearch(index: ArrayIndex): BOOLEAN;

        VAR
            aDebugSEntry:        DebugSEntry;

        BEGIN
        pSymTable.GetElementsAt(index, @aDebugSEntry, 1);
        UprMAName(aDebugSEntry.sym);
        IF sym = aDebugSEntry.sym THEN
            BEGIN
            IF aDebugSEntry.addr = NIL THEN
                asDecimal := Longint(CallSymActionProc(aDebugSEntry.actionProc))
            ELSE
                asDecimal := LongIntPtr(aDebugSEntry.addr)^;
            DoSymSearch := TRUE;
            END
        ELSE
            DoSymSearch := FALSE;
        END;

    BEGIN
    asDecimal := 0;
    asHex := 0;
    gotSymbol := FALSE;

    s := GetPromptedString(prompt, helpProc);
    UprString(s, FALSE);

    IF s = '' THEN
        GetPromptedValue := FALSE
    ELSE
        BEGIN
        GetPromptedValue := TRUE;

        IF symbolOK & ((s[1] = '''') | NOT (s[1] IN ['-', '0'..'9', 'A'..'F'])) THEN
            BEGIN
            gotSymbol := TRUE;

            IF s[1] = '''' THEN
                Delete(s, 1, 1);

            sym := s;

            asDecimal := CallSymbolLookup(sym, pSymbolProc);

            IF asDecimal = - 1 THEN                     { search local symbol table }
                IF pSymTable.EachElementDoTil(DoSymSearch, kIterateForward) = 0 THEN;
            asHex := asDecimal;

            IF asHex = - 1 THEN
                BEGIN
                WriteLn(kDontKnow);
                GetPromptedValue := FALSE;
                END;
            END
        ELSE
            BEGIN
            gotNegation := FALSE;
            FOR i := 1 TO length(s) DO
                BEGIN
                ch := s[i];

                digit := - 1;
                IF ch IN ['0'..'9'] THEN
                    digit := ord(ch) - ord('0')
                ELSE IF ch IN ['-'] THEN
                    gotNegation := TRUE
                ELSE IF ch IN ['A'..'F'] THEN
                    BEGIN
                    digit := 10 + ord(ch) - ord('A');
                    asDecimal := - 1;
                    END
                ELSE
                    BEGIN
                    asDecimal := - 1;
                    asHex := - 1;
                    WriteLn(kDontKnow);
                    GetPromptedValue := FALSE;
                    Exit(GetPromptedValue)
                    END;

                IF digit >= 0 THEN
                    BEGIN
                    IF asDecimal >= 0 THEN
                        asDecimal := 10 * asDecimal + digit;
                    IF asHex >= 0 THEN
                        asHex := 16 * asHex + digit;
                    END;
                END;
            IF gotNegation THEN
                BEGIN
                IF (asDecimal >= 0) THEN
                    asDecimal := - asDecimal;
                IF asHex >= 0 THEN
                    asHex := - asHex;
                END;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNumber(prompt: StringPtr; VAR asDecimal, asHex: Longint): BOOLEAN; { returns
    TRUE iff a valid number is typed; if it returns FALSE but the parameters are 0, then the user
    typed only a return }

    VAR
        symbol:             BOOLEAN;

    BEGIN
    GetPromptedNumber := GetPromptedValue(prompt, asDecimal, asHex, FALSE, symbol);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedNumberWithDefault(prompt: StringPtr; default: INTEGER): INTEGER;
{ Returns a number typed by the user.  Returns the default if a return is typed. }

    VAR
        s:                    Str255;

    BEGIN
    ConcatNumber(concat(prompt^, ' [default = '), default, s);
    s := concat(s, ']?:');
    IF GetPromptedNumber(@s, asDecimal, asHex) THEN
        GetPromptedNumberWithDefault := asDecimal
    ELSE
        GetPromptedNumberWithDefault := default;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetPromptedStringWithDefault(prompt: StringPtr; default: StringPtr;
                                      PROCEDURE helpProc): Str255;
{ Returns a string typed by the user.  Returns the default if a return is typed. }

    VAR
        s:                    Str255;

    BEGIN
    s := concat(prompt^, ' [default = ', default^, ']?:');
    s := GetPromptedString(@s, helpProc);
    IF s <> '' THEN
        GetPromptedStringWithDefault := s
    ELSE
        GetPromptedStringWithDefault := default^;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$IFC IncludeDisassembler}

PROCEDURE ShowDisasmMemory(startAddress, numBytes: Longint);

    VAR
        idx:                INTEGER;
        BytesUsed:            INTEGER;
        opCode, Operand, Comment: DisAsmStr80;

    BEGIN
    WHILE numBytes > 0 DO
        BEGIN
        Disassembler(0, BytesUsed, startAddress, opCode, Operand, Comment, @Lookup);
        Write('    ');
        WritePtr(startAddress);
        Write(':  '); WriteLn(opCode, ' ', Operand, ' ', Comment);
        numBytes := numBytes - BytesUsed;
        startAddress := startAddress + BytesUsed;
        END;
    pMoreMem := startAddress;
    END;
{$EndC}

{$EndC}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowMemory(startAddress, numBytes: Longint);

    VAR
        i:                    INTEGER;
        addr:                Longint;
        lines:                INTEGER;
        numeric:            STRING[40];
        ascii:                STRING[16];
        numPos:             INTEGER;
        ascPos:             INTEGER;
        decNumber:            Longint;
        chCode:             INTEGER;
        j:                    INTEGER;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE BlankLine;

        CONST
            k8Spaces            = '        ';

        BEGIN
        ascii := concat(k8Spaces, k8Spaces);
        numeric := concat(ascii, ascii, k8Spaces);
        numPos := 0;
        ascPos := 0;
        END;

{--------------------------------------------------------------------------------------------------}

    PROCEDURE PrintLine;

        BEGIN
        WriteLn(numeric, '  ', ascii);
        END;

    BEGIN
    IF Odd(startAddress) THEN
        WriteLn('Odd Address')
    ELSE IF numBytes > 0 THEN
        BEGIN
        BlankLine;

        FOR i := 0 TO (numBytes - 1) DIV 2 DO
            BEGIN
            lines := 0;
            addr := startAddress + i + i;

            IF (i MOD 8) = 0 THEN
                BEGIN
                IF i > 0 THEN
                    BEGIN
                    PrintLine;
                    BlankLine;
                    lines := lines + 1;
                    END;
                IF IsUserBreak | (lines > 20) THEN
                    BEGIN
                    WriteLn('More… [M]: ');
                    Exit(ShowMemory);
                    END;
                Write('    ');
                WritePtr(addr);
                Write(':  ');
                END;

            decNumber := IntegerPtr(addr)^;
            FOR j := 4 DOWNTO 1 DO
                BEGIN
                numeric[numPos + j] := kHexDigits[BAND(decNumber, 15) + 1];
                decNumber := BSR(decNumber, 4);
                END;

            decNumber := IntegerPtr(addr)^;
            FOR j := 2 DOWNTO 1 DO
                BEGIN
                chCode := BAND(decNumber, 255);
                IF (chCode < $20) | (chCode > $D8) | (chCode = $7F) THEN { control, unassigned, or
                                                                          DEL }
                    chCode := ord('•');
                ascii[ascPos + j] := chr(chCode);
                decNumber := BSR(decNumber, 8);
                END;

            numPos := numPos + 5;
            ascPos := ascPos + 2;

            pMoreMem := addr + 2;
            END;

        PrintLine;
        END;
    END;

{$IFC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION ShowHierarchy(obj: TObject; theClass: ObjClassID): Longint;

    VAR
        inspClass:            MAName;
        size:                Longint;
        super:                ObjClassID;
        shown:                INTEGER;

    BEGIN
    GetClassNameFromID(theClass, inspClass);            { srf 88.9.7 }

    IF inspClass = kInvalidObj THEN
        BEGIN
        size := GetHandleSize(Handle(obj));
        ShowMemory(ord(Handle(obj)^), size);
        END
    ELSE
        BEGIN
        size := GetClassSizeFromID(theClass);
        super := GetSuperClassID(theClass);
        IF super = kNilClass THEN                        { it is a root class, so skip class ptr }
            shown := sizeof(ObjClassID)
        ELSE
            shown := ShowHierarchy(obj, super);
        IF shown <= size THEN
            BEGIN
            GetClassNameFromID(theClass, inspClass);
            WriteLn(' ', inspClass);
            IF size > sizeof(ObjClassID) THEN            { don't show it if there are no fields }
                ShowMemory(ord(Handle(obj)^) + shown, size - shown);
            END;
        END;

    ShowHierarchy := size;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowFields(obj: TObject; doInspect: BOOLEAN);

    VAR
        i:                    Longint;
        s:                    Longint;
        objName:            MAName;

    BEGIN
    IF ord(obj) = - 1 THEN
        Write('')
    ELSE IF ord(obj) = - 2 THEN
        WriteLn('  No object at that level (not a method).')
    ELSE IF VerboseIsObject(obj) THEN
        BEGIN
        IF doInspect THEN
            BEGIN
            {###obj.Fields(pDebugView);}
            WriteLn;
            END
        ELSE
            BEGIN
            i := ShowHierarchy(obj, GetClassID(obj));
            s := GetHandleSize(Handle(obj));
            IF i < s THEN
                BEGIN
                WriteLn('rest of handle:');
                ShowMemory(ord(Handle(obj)^) + i, s - i);
                END;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     { Shouldn't be unloaded }

PROCEDURE GetLevel(level: INTEGER; topFrame: Longint; VAR calleeFrame, itsFrame: Longint);

    VAR
        i:                    INTEGER;

    BEGIN
    calleeFrame := topFrame;
    IF Odd(calleeFrame) THEN
        itsFrame := calleeFrame
    ELSE
        BEGIN
        itsFrame := LongIntPtr(calleeFrame)^;
        FOR i := 1 TO level DO
            IF Odd(itsFrame) | (itsFrame >= Longint(GetA5)) | (itsFrame <= calleeFrame) THEN
                itsFrame := calleeFrame
            ELSE
                BEGIN
                calleeFrame := itsFrame;
                itsFrame := LongIntPtr(itsFrame)^;
                END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE GetFrameInfo(calleeFrame: Longint; ppc: Longint; VAR callerFrame: Longint;
                       VAR itsFrame: Longint; VAR itsReceiver: TObject; VAR className: MAName;
                       VAR procName: MAName; VAR rcvrHandle: HexAddress; VAR rcvrClass: MAName;
                       VAR theSegNum: INTEGER);

    VAR
        aStringPtr:         StringPtr;

    BEGIN
    GetProcName(ppc, className, procName);
    theSegNum := GetSegFromPC(ppc);

    GetLevel(1, calleeFrame, itsFrame, callerFrame);

    rcvrClass := kInvalidObj;
    IF Odd(itsFrame) | (length(className) = 0) THEN
        BEGIN
        Longint(itsReceiver) := - 2;
        rcvrHandle := kInvalidObj;
        END
    ELSE
        BEGIN
        Longint(itsReceiver) := LongIntPtr(itsFrame + 8)^;
        aStringPtr := StringPtr(@rcvrHandle);
        PointerToHex(itsReceiver, aStringPtr^, 8);
        IF IsObject(itsReceiver) THEN
            GetClassNameFromID(GetClassID(itsReceiver), rcvrClass);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION GetRcvrAtLevel(level: INTEGER; topFrame: Longint): TObject;

    VAR
        calleeFrame, callerFrame, itsFrame: Longint;
        receiver:            TObject;
        className, procName, rcvrClass: MAName;
        rcvrHandle:         HexAddress;
        dummy:                INTEGER;

    BEGIN
    itsFrame := topFrame;
    REPEAT
        calleeFrame := itsFrame;
        GetFrameInfo(calleeFrame, calleeFrame + 4, callerFrame, itsFrame, receiver, className,
                     procName, rcvrHandle, rcvrClass, dummy);
        level := level - 1;
    UNTIL (level < 0) | (calleeFrame = itsFrame);
    GetRcvrAtLevel := receiver;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowLocals(level: INTEGER; topFrame: Longint);

    VAR
        startAt, finishAt:    Longint;
        itsFrame, calleeFrame: Longint;

    BEGIN
    GetLevel(level, topFrame, calleeFrame, itsFrame);
    startAt := max(calleeFrame + 8, itsFrame - 80);
    finishAt := itsFrame;
    ShowMemory(startAt, finishAt - startAt);
    IF pMoreMem >= finishAt THEN
        WriteLn('  The first locals declared appear last or are in reg''s.');
    END;

{
 calleeFrame: PREV LINK
 calleeFrame+4: PREV RA
 calleeFrame+8: PREV PARAMS
 MY LOCALS
 itsFrame: MY LINK
 itsFrame+4: MY RA
 itsFrame+8: MY PARAMS (IF A METHOD: callerFrame+8=SELF)
 NEXT LOCALS
 callerFrame: NEXT LINK
 }

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowParameters(level: INTEGER; topFrame: Longint);

    VAR
        startAt, finishAt:    Longint;
        itsFrame, callerFrame: Longint;

    BEGIN
    GetLevel(level + 1, topFrame, itsFrame, callerFrame);
    startAt := itsFrame + 8 + 4 * ord(ord(GetRcvrAtLevel(level, topFrame)) > 0);
    finishAt := Min(startAt + 80, callerFrame);
    WriteLn('  The last argument you declared is shown first below.');
    ShowMemory(startAt, finishAt - startAt);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowNames(VAR procName: MAName; segNum: INTEGER);

    BEGIN
    Write(procName);
    IF segNum > 0 THEN
        Write(' Seg#: ', segNum: 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowWhyInDebugger(aWhyInDebugger: WhyInDebugger; VAR procName: MAName; segNum: INTEGER);

    BEGIN
    CASE aWhyInDebugger OF
        tBegin:
            Write('Begin  ');
        tEnd:
            Write('End    ');
        tExit:
            Write('Exit   ');
        tBeginEndPair:
            Write('BegEnd ');
        tSysError:
            Write('SysErr ');
        tProgBreak:
            Write('Break  ');
        tVBL:
            Write('VBL Break  ');
    END;

    ShowNames(procName, segNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowSymbolWhyInDebugger(aWhyInDebugger: WhyInDebugger; VAR procName: MAName;
                                  segNum: INTEGER);

    BEGIN
    CASE aWhyInDebugger OF
        tBegin:
            Write('>');
        tEnd:
            Write('<');
        tExit:
            Write('^ Exit: ');
        tBeginEndPair:
            Write('');
        tSysError:
            Write(': SysErr');
        tProgBreak:
            Write(': Break');
        tVBL:
            Write(': VBL Break');
    END;
    ShowNames(procName, segNum);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowRecent;
{ show recent history of pc.  Indents to show nesting level }

    CONST
        kIndentMax            = 31;                        { must be a power of 2 minus 1 }
        kIndentAmount        = 2;                        { number of spaces per nesting level }
        kDupClassName        = '=';
        kFailureProc        = 'FAILURE';

    VAR
        nextProcName, className, lastClassName: MAName;
        procName:            MAName;
        i:                    INTEGER;
        nexti:                INTEGER;
        pc:                 Longint;
        indentLevel, maxIndentLevel: INTEGER;
        aString:            Str255;
        aWhyInDebugger:     WhyInDebugger;

    BEGIN
    { get the maximum indenting or outdenting level first }
    maxIndentLevel := 0;
    i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
    REPEAT
        WITH pRecentPC[i] DO
            IF thePC <> 0 THEN
                BEGIN
                CASE theWhyInDebugger OF
                    tBegin:
                        maxIndentLevel := maxIndentLevel + kIndentAmount;
                    tEnd, tBeginEndPair:
                        maxIndentLevel := maxIndentLevel - kIndentAmount;
                    tExit: ;
                END;
                END;
        i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
    UNTIL i = pRecentIndex;

    { try to intelligently set a starting indent level }
    IF maxIndentLevel < 0 THEN                            { some outdenting required }
        indentLevel := Min(abs(maxIndentLevel), (kIndentMax + 1) DIV 2)
    ELSE
        indentLevel := 0;                                { only indents }

    lastClassName := '';
    aString := '| | | | | | | | | | | | | | | ';
    i := BAND(pRecentIndex + 1, kRecent);                { absolute value, modulo kRecent }
    REPEAT
        WITH pRecentPC[i] DO
            IF thePC <> 0 THEN
                BEGIN
                GetProcName(ord(@thePC), className, procName);
                aWhyInDebugger := theWhyInDebugger;
                nexti := BAND(i + 1, kRecent);
                IF nexti <> pRecentIndex THEN
                    BEGIN
                    GetMethodName(ord(@pRecentPC[nexti].thePC), nextProcName);
                    IF nextProcName = procName THEN
                        BEGIN
                        aWhyInDebugger := tBeginEndPair;
                        i := nexti;
                        END;
                    END;
                CASE aWhyInDebugger OF
                    tBegin, tBeginEndPair:
                        indentLevel := BAND(indentLevel + kIndentAmount, kIndentMax);
                END;
                aString[0] := chr(indentLevel);
                Write(aString);
                CASE aWhyInDebugger OF
                    tEnd, tBeginEndPair:
                        indentLevel := BAND(indentLevel - kIndentAmount, kIndentMax);
                    tExit: ;
                END;
                IF (lastClassName = className) & (length(className) <> 0) THEN
                    BEGIN
                    Delete(procName, 1, length(className));
                    insert(kDupClassName, procName, 1);
                    END;
                lastClassName := className;
                ShowSymbolWhyInDebugger(aWhyInDebugger, procName, - 1);
                WriteLn;
                IF (aWhyInDebugger = tExit) | ((length(className) = 0) & (procName =
                   kFailureProc)) THEN
                    WriteLn('------------------------------');
                END;
        i := BAND(i + 1, kRecent);                        { absolute value, modulo kRecent }
    UNTIL i = pRecentIndex;
    WriteLn;

    pMoreMem := - 1;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowStack;

    VAR
        startLevel:         INTEGER;
        interrupted:        BOOLEAN;
    {??? moved strings out to this level to help reduce the stack rqs of recursion.
    Eventually should fix even better than this ???}
        className:            MAName;
        procName:            MAName;
        rcvrClass:            MAName;
        rcvrHandle:         HexAddress;

    PROCEDURE ShowLevel(level: INTEGER; calleeFrame, ppc: Longint);

        VAR
            callerFrame:        Longint;
            itsFrame:            Longint;
            receiver:            TObject;
            segNum:             INTEGER;

        BEGIN
        GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
                     rcvrHandle, rcvrClass, segNum);

        IF calleeFrame <> itsFrame THEN
            BEGIN
            nextLevel := level + 1;
            nextFrame := itsFrame;
            pNextPC := itsFrame + 4;
            ShowLevel(nextLevel, nextFrame, pNextPC)
            END;

        Write(' ', level: 3, ' ');
        WritePtr(calleeFrame);
        Write(': ');

        { retrieve names for this frame again }
        GetFrameInfo(calleeFrame, ppc, callerFrame, itsFrame, receiver, className, procName,
                     rcvrHandle, rcvrClass, segNum);

        ShowNames(procName, segNum);
        IF ord(receiver) > 0 THEN
            Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
        WriteLn;
        END;

    BEGIN
    pMoreMem := - 1;
    startLevel := nextLevel;

    ShowLevel(startLevel, nextFrame, pNextPC);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAUtilitiesRes}                                     { Shouldn't be unloaded }
{$Push} {$Z+}

PROCEDURE EachFrameDo(calleeFrame, ppc: Longint; PROCEDURE
                      DoToFrame(calleeFrame: Longint; ppc: Longint; callerFrame: Longint;
                                itsFrame: Longint));

    PROCEDURE DoLevel(calleeFrame, ppc: Longint);

        VAR
            callerFrame:        Longint;
            itsFrame:            Longint;
            nextFrame:            Longint;
            pNextPC:            Longint;

        BEGIN
        GetLevel(1, calleeFrame, itsFrame, callerFrame);
        DoToFrame(calleeFrame, ppc, callerFrame, itsFrame);
        IF calleeFrame <> itsFrame THEN
            BEGIN
            nextFrame := itsFrame;
            pNextPC := itsFrame + 4;
            DoLevel(nextFrame, pNextPC)
            END;
        END;

    BEGIN
    DoLevel(calleeFrame, ppc);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowTempSpace(VAR lockedSpace, totalSpace: Longint);

    VAR
        seg:                Handle;

    BEGIN
    lockedSpace := TotalTempSize(TRUE, seg);
    totalSpace := TotalTempSize(FALSE, seg);

    WriteLn('  Current temp space: locked = ', lockedSpace: 1, ', unlocked = ', totalSpace -
            lockedSpace: 1, ', total = ', totalSpace: 1);

    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ShowHeapInfo;

    VAR
        codeRes:            Longint;
        codeShort:            Longint;
        lockedSpace:        Longint;
        lowSpaceRes:        Longint;
        okCode:             BOOLEAN;
        okLowSpace:         BOOLEAN;
        oldPerm:            BOOLEAN;
        oldRsrcUse:         Longint;
        purgeSpace:         Longint;
        totalSpace:         Longint;

    BEGIN
    oldRsrcUse := gMaxLockedRsrc;

    {== S T A C K ==}
    WriteLn('STACK');
    WriteLn('  Current total stack = ', pStackSpace: 1, '           Maximum stack used = ',
            gMaxStackDepth: 1);
    WriteLn('  Current procedure stack = ', pProcStack: 1, '           Available stack = ',
            ord(GetCurStackBase) - ord(GetApplLimit): 1);

    IF pBreakStack < $7FFFFFFF THEN
        WriteLn('Break at total stack space = ', pBreakStack: 1);
    IF pBrProcStack < $7FFFFFFF THEN
        WriteLn('Break at procedure stack space = ', pBrProcStack: 1);

    {== R E S E R V E S ==}
    WriteLn('RESERVES');
    DoChangeReserve(FALSE, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);

    Write('  code = ', codeRes: 1);
    IF okCode THEN
        Write(' (OK)')
    ELSE
        Write(' (low: ', codeShort: 1, ')');

    Write('     low space = ', lowSpaceRes: 1);
    IF okLowSpace THEN
        Write(' (OK)')
    ELSE
        Write(' (gone)');

    Write('  allocation flag: ');
    IF pPermFlag THEN
        WriteLn('permanent')
    ELSE
        WriteLn('temporary');

    {== T E M P  S P A C E ==}
    WriteLn('TEMP SPACE');
    ShowTempSpace(lockedSpace, totalSpace);

    purgeSpace := totalSpace - codeRes;
    IF purgeSpace > (totalSpace - lockedSpace) THEN
        purgeSpace := totalSpace - lockedSpace;

    IF purgeSpace >= 0 THEN
        WriteLn('  Purgeable temp space = ', purgeSpace: 1)
    ELSE
        WriteLn('  Needed reserve handle size = ', - purgeSpace: 1);

    {== O T H E R ==}
    WriteLn('OTHER');
    CheckRsrcUsage;

    Write('  Max resource usage = ', gMaxLockedRsrc: 1);
    IF oldRsrcUse <> gMaxLockedRsrc THEN
        WriteLn(' (new)')
    ELSE
        WriteLn;

    gMaxLockedRsrc := oldRsrcUse;                        { so we get the '(new)' indications again }

    oldPerm := PermAllocation(TRUE);
    totalSpace := FreeMem;
    oldPerm := PermAllocation(oldPerm);

    WriteLn('  (permanent) FreeMem = ', totalSpace: 1, '            Free master pointers = ',
            GetFreeMastersCount: 1);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE HeapCmd;

    VAR
        ch:                 CHAR;
        decNum:             Longint;
        done:                BOOLEAN;
        hexNum:             Longint;
        x:                    Longint;
        y:                    Longint;

        id:                 INTEGER;
        name:                Str255;
        nSeg:                INTEGER;
        seg:                Handle;
        t:                    ResType;

        codeRes:            Longint;
        codeShort:            Longint;
        lowSpaceRes:        Longint;
        okCode:             BOOLEAN;
        okLowSpace:         BOOLEAN;
        oldPerm:            BOOLEAN;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('+ -- set breakpoint on procedure stack usage');
        WriteLn('B -- set breakpoint on total stack usage');
        WriteLn('D -- reset maximum stack depth');
        WriteLn('I -- show heap/stack info');
        WriteLn('M -- show heap/stack info AND MaxMem');
        WriteLn('R -- show/set heap reserve');
        WriteLn('S -- list LOADED segments');
        WriteLn('ß (option-S) -- list ALL segments');
        WriteLn;
        END;

    PROCEDURE ShowSegments(allSegments: BOOLEAN);
    { Show segment information.  if allSegments is true then also show unloaded & purged }

        VAR
            i:                    INTEGER;

        BEGIN
        codeRes := 0;                                    { counts size of code segments }

        nSeg := GetHandleSize(Handle(gCodeSegs)) DIV sizeof(Handle);

        WriteLn('Total # segments = ', nSeg: 1);
        IF allSegments THEN
            WriteLn(
        '• = resident, L = loaded, U = unloaded (and relocatable), '' '' = purged (or never loaded)'
                    )
        ELSE
            WriteLn('• = resident, L = loaded');

        FOR i := 1 TO nSeg DO
            BEGIN
            seg := gCodeSegs^^[i];
            IF allSegments | (NOT IsHandlePurged(seg) & isHandleLocked(seg)) THEN
                BEGIN
                GetResInfo(seg, id, t, name);

                WritePtr(seg);

                Write('  Seg#:', id: 3, ' ');

                IF gIsResidentSeg^^[i] THEN
                    Write('• ')
                ELSE IF IsHandlePurged(seg) THEN
                    Write('  ')
                ELSE IF gIsLoadedSeg^^[i] THEN
                    Write('L ')
                ELSE
                    Write('U ');

                Write(name, ' ': 25 - length(name), ' ');

                WriteLn(pSegSize^^[i]: 6, ' bytes');

                codeRes := codeRes + pSegSize^^[i] + 8;
                END;
            END;

        WriteLn;
        WriteLn('Total loaded code = ', codeRes: 1);
        ShowTempSpace(x, y);
        END;

    BEGIN
    done := FALSE;
    REPEAT
        ch := GetPromptedChar(AtStr('Heap/Stack Cmd'), AtStr('+BDIMRSß'), helpProc);

        CASE ch OF
            '+':
                BEGIN
                IF GetPromptedNumber(AtStr('Break at what procedure stack usage?: '), decNum,
                                     hexNum) THEN

                    IF decNum = 0 THEN
                        pBrProcStack := $7FFFFFFF
                    ELSE IF decNum > 0 THEN
                        pBrProcStack := decNum;

                ShowHeapInfo;

                done := TRUE;
                END;

            'B':
                BEGIN
                IF GetPromptedNumber(AtStr('Break at what total stack usage?: '), decNum,
                   hexNum) THEN
                    IF decNum = 0 THEN
                        pBreakStack := $7FFFFFFF
                    ELSE IF decNum > 0 THEN
                        pBreakStack := decNum;

                ShowHeapInfo;

                done := TRUE;
                END;

            'D':
                BEGIN
                gMaxStackDepth := - 1;

                ShowHeapInfo;

                done := TRUE;
                END;

            'I':
                BEGIN
                ShowHeapInfo;
                done := TRUE;
                END;

            'M':
                BEGIN
                oldPerm := PermAllocation(TRUE);
                x := MaxMem(decNum);
                oldPerm := PermAllocation(oldPerm);

                ShowHeapInfo;

                WriteLn('(permanent) MaxMem = ', x: 1);

                done := TRUE;
                END;

            'R':
                BEGIN
                DoChangeReserve(TRUE, codeRes, codeShort, lowSpaceRes, okCode, okLowSpace);
                ShowHeapInfo;
                done := TRUE;
                END;

            'S':
                BEGIN
                ShowSegments(FALSE);

                done := TRUE;
                END;

            'ß':
                BEGIN
                ShowSegments(TRUE);

                done := TRUE;
                END;

            OTHERWISE
                done := TRUE;
        END;
    UNTIL done;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE SetBreakCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        aClassName, aProcName: MAName;

    BEGIN
    IF pBreakCount < 10 THEN
        BEGIN
        IF GetPromptedNames(AtStr('Break at [Typename.ProcName or ProcName]?: '), aClassName,
                            aProcName) THEN
            BEGIN
            pBreakCount := pBreakCount + 1;
            pBreakClass[pBreakCount] := aClassName;
            pBreakProc[pBreakCount] := aProcName;
            END
        END
    ELSE
        WriteLn('Already have maximum breakpoints set!');
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE ClrBreakCmd;

    VAR
        aString:            Str255;
        whichBreak:         Longint;

    PROCEDURE ClrBreakHelp;

        VAR
            i:                    INTEGER;

        BEGIN
        WriteLn;
        WriteLn('A - All breakpoints');
        FOR i := 1 TO pBreakCount DO
            BEGIN
            Write(i: 1, ' - ');
            IF pBreakClass[i] <> '' THEN
                WriteLn(pBreakClass[i], '.', pBreakProc[i])
            ELSE
                WriteLn(pBreakProc[i]);
            END;
        END;

    BEGIN
    CASE pBreakCount OF
        0:
            WriteLn('No breakpoints are set!.');
        1:
            BEGIN
            pBreakCount := 0;
            WriteLn('Cleared the breakpoint.');
            END;
        OTHERWISE
            BEGIN
            ConcatNumber('Which breakpoint[1-', pBreakCount, aString);
            aString := concat(aString, ',A]?:');
            aString := GetPromptedString(@aString, ClrBreakHelp);
            UprStr255(aString);
            IF aString = 'A' THEN
                BEGIN
                pBreakCount := 0;
                WriteLn('Cleared all the breakpoints.');
                END
            ELSE IF aString <> '' THEN
                BEGIN
                StringToNum(aString, whichBreak);
                IF (whichBreak > 0) & (whichBreak <= pBreakCount) THEN
                    BEGIN
                    WHILE whichBreak < pBreakCount DO
                        BEGIN
                        pBreakClass[whichBreak] := pBreakClass[whichBreak + 1];
                        pBreakProc[whichBreak] := pBreakProc[whichBreak + 1];
                        whichBreak := whichBreak + 1;
                        END;
                    pBreakCount := pBreakCount - 1;
                    WriteLn('Cleared the breakpoint.');
                    END;
                END;
            END;
    END;
    END;

{--------------------------------------------------------------------------------------------------}
{$Ifc qPerform}
{$S MADebugger}

PROCEDURE PerfCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        aBool:                BOOLEAN;
        perfErr:            INTEGER;
        s:                    Str255;
        ms:                 INTEGER;
        apName:             Str255;
        apRefnum:            INTEGER;
        apParam:            Handle;

    PROCEDURE helpProc;

        BEGIN
        WriteLn;
        WriteLn('D -- Dump to output file');
        WriteLn('E -- End the tools and free their storage');
        WriteLn('I -- Init performance tools');
        WriteLn('T -- Toggle tools on and off');
        WriteLn;
        END;

    PROCEDURE appCodeTypeHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify the resource type to measure');
        WriteLn;
        END;

    PROCEDURE romNameHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify the ROM name');
        WriteLn;
        END;

    PROCEDURE reportFileHelpProc;

        BEGIN
        WriteLn;
        WriteLn('Please specify a file name for the report');
        WriteLn;
        END;

    BEGIN
    done := FALSE;
    REPEAT
        ch := GetPromptedChar(AtStr('Performance Cmd'), AtStr('DEIT'), helpProc);

        CASE ch OF
            'D':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    WriteLn('Dump performance tools data.  Press Return to take the default…');
                    GetAppParms(apName, apRefnum, apParam);
                    s := concat(apName, '.perf');
                    perfErr := PerfDump(pTP2PerfGlobals,
                                        GetPromptedStringWithDefault(AtStr('  reportFile'), @s,
                                        reportFileHelpProc), GetPromptedNumberWithDefault(AtStr(
                                        '  doHistogram (TRUE=1/FALSE=0)'), 0) = 1,
                                        GetPromptedNumberWithDefault(AtStr('  rptFileColumns'),
                               80));
                    IF perfErr <> NoErr THEN
                        WriteLn('Error: ', perfErr, ' while dumping');
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := TRUE;
                END;
            'E':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    TermPerf(pTP2PerfGlobals);
                    pTP2PerfGlobals := NIL;
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := TRUE;
                END;
            'I':
                BEGIN
                IF pTP2PerfGlobals = NIL THEN
                    BEGIN
                    WriteLn('Init performance tools.  Press Return to take the default…');
                    { set the default }
                    CASE gConfiguration.machineType OF
                        gestaltClassic, gestaltMacXL, gestaltMac512KE, gestaltMacPlus, gestaltMacSE:
                            ms := 10;
                        OTHERWISE
                            ms := 4;
                    END;
                    aBool := InitPerf(pTP2PerfGlobals,
                                      GetPromptedNumberWithDefault(AtStr('  timerCount'), ms),
                                      GetPromptedNumberWithDefault(AtStr('  codeAndROMBucketSize'),
                                                                   8),
                                      GetPromptedNumberWithDefault(AtStr('  doROM (TRUE=1/FALSE=0)'
                                                                          ), 0) = 1,
                                      GetPromptedNumberWithDefault(AtStr(
                                                                      '  doAppCode (TRUE=1/FALSE=0)'
                                                                         ), 1) = 1,
                                      GetPromptedStringWithDefault(AtStr('  appCodeType'),
                                                                   AtStr('CODE'),
                                                                   appCodeTypeHelpProc),
                                      GetPromptedNumberWithDefault(AtStr('  romID'), 0),
                                      GetPromptedStringWithDefault(AtStr('  romName'), AtStr(''),
                                                                   romNameHelpProc),
                                      GetPromptedNumberWithDefault(AtStr('  doRAM (TRUE=1/FALSE=0)')
                                                                   , 0) = 1,
                                      GetPromptedNumberWithDefault(AtStr('  ramLow'), 0),
                                      GetPromptedNumberWithDefault(AtStr('  ramHigh'), 0),
                                      GetPromptedNumberWithDefault(AtStr('  ramBucketSize'), 8));
                    IF NOT aBool THEN
                        WriteLn('Performance tools initialization FAILED.');
                    END
                ELSE
                    WriteLn('Already initialized!');

                done := TRUE;
                END;
            'T':
                BEGIN
                IF pTP2PerfGlobals <> NIL THEN
                    BEGIN
                    oldState := NOT oldState;
                    END
                ELSE
                    WriteLn('Not initialized!');
                done := TRUE;
                END;
            OTHERWISE
                done := TRUE;
        END;
    UNTIL done;
    END;
{$Endc}
{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE FlagCmd;

    VAR
        done:                BOOLEAN;
        ch:                 CHAR;
        i:                    INTEGER;
        theFlags:            Str255;
        newState:            BOOLEAN;
        theCount:            INTEGER;
        actionCh:            CHAR;

    PROCEDURE FlagInfo(desc: StringHandle; addr: BooleanPtr);

        BEGIN
        HLock(Handle(desc));
{$Push} {$H-}
        Write(desc^^, ': ');
{$Pop}
        HUnLock(Handle(desc));
        IF addr^ THEN
            WriteLn('TRUE')
        ELSE
            WriteLn('FALSE');
        END;

    PROCEDURE helpProc;

        VAR
            i:                    INTEGER;

        FUNCTION DoFlag(index: ArrayIndex): BOOLEAN;

            VAR
                aDebugFEntry:        DebugFEntry;

            BEGIN
            pFlagTable.GetElementsAt(index, @aDebugFEntry, 1);
            WITH aDebugFEntry DO
                BEGIN
                Write(ch, ' -- ');
                FlagInfo(desc, addr);
                END;
            DoFlag := FALSE;
            END;

        BEGIN
        WriteLn;
        IF pFlagTable.EachElementDoTil(DoFlag, kIterateForward) = 0 THEN;
        WriteLn;
        END;

    FUNCTION DoFlagCase(index: ArrayIndex): BOOLEAN;

        VAR
            aDebugFEntry:        DebugFEntry;

        BEGIN
        pFlagTable.GetElementsAt(index, @aDebugFEntry, 1);
        WITH aDebugFEntry DO
            BEGIN
            IF addr^ THEN
                theFlags[length(theFlags) + 1] := UprChar(ch)
            ELSE
                theFlags[length(theFlags) + 1] := LowerChar(ch);
            theFlags[0] := chr(length(theFlags) + 1);
            END;
        DoFlagCase := FALSE;
        END;

    FUNCTION DoFlagAction(index: ArrayIndex): BOOLEAN;

        VAR
            aDebugFEntry:        DebugFEntry;

        BEGIN
        pFlagTable.GetElementsAt(index, @aDebugFEntry, 1);
        WITH aDebugFEntry DO
            BEGIN
            IF ch = actionCh THEN
                BEGIN
                newState := NOT addr^;
                IF actionProc <> NIL THEN
                    IF CallFlagActionProc(newState, actionProc) THEN; { discard result }
                addr^ := newState;
                FlagInfo(desc, addr);
                pFlagTable.ReplaceElementsAt(index, @aDebugFEntry, 1);
                DoFlagAction := TRUE;
                END;
            END;
        DoFlagAction := FALSE;
        END;

    BEGIN
    done := FALSE;
    REPEAT
        { Set the display case correctly on all the flags }
        theFlags := '';
        IF pFlagTable.EachElementDoTil(DoFlagCase, kIterateForward) = 0 THEN;

        ch := GetPromptedChar(AtStr('Toggle Flag'), @theFlags, helpProc);
        CASE ch OF
            chReturn:
                done := TRUE;
            OTHERWISE
                BEGIN
                actionCh := ch;
                IF pFlagTable.EachElementDoTil(DoFlagAction, kIterateForward) = 0 THEN;
                END;
        END;
    UNTIL done;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DoFullStop;

    VAR
        nubPSN:             ProcessSerialNumber;
        aERec:                EventRecord;
        wasFront:            BOOLEAN;

    BEGIN
    pMoreMem := - 1;
    IF IsFrontProcess THEN
        wasFront := TRUE
    ELSE
        wasFront := FALSE;

    IF wasFront THEN
        HiliteMenu(mDebug);

    IF pAtBreak THEN
        pAtBreak := FALSE;

    REPEAT
        NubWaitNextEvent;
    UNTIL NOT pStoppedInDebugger;

    { Make sure that we are in the foreground if we were stopped there }
    IF (NOT gSingleStep) & (pStepOverStackSize = 0) & wasFront THEN
        BEGIN
        FailOSErr(GetCurrentProcess(nubPSN));
        FailOSErr(SetFrontProcess(nubPSN));
        FailOSErr(WakeUpProcess(nubPSN));
        WHILE NOT WaitNextEvent(everyEvent, aERec, 1, NIL) DO;
        HiliteMenu(0);
        END;
    END;

{$EndC}
{$IFC qDebug}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebuggerDispatch(message, reply: AppleEvent; info: Longint): OSErr;

    VAR
        theEventClass:        AEEventClass;
        theEventID:         AEEventID;

        actualType:         DescType;
        actualSize:         size;
        typeCode:            DescType;
        theErr:             OSErr;
        savedScript:        INTEGER;
        ch:                 CHAR;

        error, errMessage:    INTEGER;
        gotSymbol:            BOOLEAN;
        myA5:                Longint;
        myPort:             GrafPtr;
        i:                    INTEGER;
        why:                Str255;

    BEGIN
    FailOSErr(AEGetAttributePtr(message, keyEventClassAttr, typeType, typeCode, @theEventClass,
                                sizeof(AEEventClass), actualSize));

    FailOSErr(AEGetAttributePtr(message, keyEventIDAttr, typeType, typeCode, @theEventID,
                                sizeof(AEEventClass), actualSize));

    IF theEventClass = 'MADB' THEN
        IF theEventID = kKeyStroke THEN
            BEGIN
            theErr := AEGetParamPtr(message, keyDirectObject, 'char', actualType, @lastCH,
                                    sizeof(CHAR), actualSize);

            END

        ELSE IF theEventID = kEnterMacsBug THEN
            BEGIN
            { Save the current script, and set it to Roman for Debugger }
            savedScript := GetEnvirons(smKeyScript);
            KeyScript(smRoman);

            DebugStr('Type ''G'' to return to the MacApp debugger.');

            KeyScript(savedScript);
            END

        ELSE IF theEventID = kExitToShell THEN
            BEGIN
            ExitToShell;
            END

        ELSE IF theEventID = kTrace THEN
            BEGIN
            pTraceToggle := NOT pTraceToggle;
            gTracing := pTraceToggle & pTraceEnabled;
            END

        ELSE IF theEventID = kGo THEN
            BEGIN
            pStoppedInDebugger := FALSE;
            pStepOverStackSize := 0;
            END

        ELSE IF theEventID = kStepOver THEN
            BEGIN
            pStoppedInDebugger := FALSE;
            gSingleStep := FALSE;
            pStepOverStackSize := pStackSpace
            END

        ELSE IF theEventID = kStepInto THEN
            BEGIN
            pStoppedInDebugger := FALSE;
            gSingleStep := TRUE;
            pStepOverStackSize := 0
            END

        ELSE IF theEventID = kStatus THEN
            BEGIN
            { Put the pointer data in as direct parameter… }
            myA5 := GetA5;
            GetPort(myPort);
            FailOSErr(AEPutParamPtr(reply, 'A5  ', typeLongInteger, @myA5, sizeof(Longint)));
            FailOSErr(AEPutParamPtr(reply, 'port', typeLongInteger, @myPort, sizeof(Longint)));
            FailOSErr(AEPutParamPtr(reply, 'trac', 'bool', @pTraceToggle, sizeof(BOOLEAN)));
{$Ifc qPerform}
            FailOSErr(AEPutParamPtr(reply, 'perf', 'bool', @oldState, sizeof(BOOLEAN)));
{$Endc}

            {###
            IF pBreakCount > 0 THEN
                BEGIN
                Write('Break[s] set at: ');
                FOR i := 1 TO pBreakCount DO
                    BEGIN
                    IF i > 1 THEN
                        Write(', ');
                    IF pBreakClass[i] <> '' THEN
                        Write(pBreakClass[i], '.', pBreakProc[i])
                    ELSE
                        Write(pBreakProc[i]);
                    END;
                END
            ELSE
                Write('No Break set.');
            }
            CASE gWhyInDebugger OF
                tBegin:
                    why := 'Begin  ';
                tEnd:
                    why := 'End    ';
                tExit:
                    why := 'Exit   ';
                tBeginEndPair:
                    why := 'BegEnd ';
                tSysError:
                    why := 'SysErr ';
                tProgBreak:
                    why := 'Break  ';
                tVBL:
                    why := 'VBL Break  ';
            END;

            FailOSErr(AEPutParamPtr(reply, 'WhyI', 'S255', @why, length(why) + 1));
            FailOSErr(AEPutParamPtr(reply, 'pnam', 'S255', @procName, length(procName) + 1));
            FailOSErr(AEPutParamPtr(reply, 'seg#', typeShortInteger, @segNum, sizeof(INTEGER)));
            IF ord(receiver) > 0 THEN
                BEGIN
                FailOSErr(AEPutParamPtr(reply, 'recv', typeLongInteger, @rcvrHandle,
                                        sizeof(INTEGER)));
                FailOSErr(AEPutParamPtr(reply, 'recC', 'S255', @rcvrClass, length(rcvrClass) + 1));
                END;

            END

        ELSE IF theEventID = kAllClasses THEN
            BEGIN
            {### AllClassesCmd;}
            END

        ELSE IF theEventID = kDisplayMem THEN
            BEGIN
            IF GetPromptedNumber(AtStr('Display memory starting where?: '), asDecimal, asHex) THEN
                IF asHex <> - 1 THEN
                    ShowMemory(asHex, 16);
            END

        ELSE IF theEventID = kDisasm THEN
            BEGIN
{$IFC IncludeDisassembler}
            IF GetPromptedNumber(AtStr('Disassemble memory starting where?: '), asDecimal,
               asHex) THEN
                IF asHex <> - 1 THEN
                    ShowDisasmMemory(asHex, 16);
{$EndC}
            END
        ELSE IF theEventID = kFieldsAsHex THEN
            BEGIN
            IF GetPromptedValue(AtStr('Fields of object [hex handle, or decimal stack level #]?: '),
                                asDecimal, asHex, TRUE, gotSymbol) THEN
                IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
                    ShowFields(GetRcvrAtLevel(asDecimal, pLink), FALSE)
                ELSE
                    ShowFields(TObject(asHex), FALSE);
            END

        ELSE IF theEventID = kInspect THEN
            BEGIN
            IF GetPromptedValue(AtStr(
                                     'Inspect what object [hex handle, or decimal stack level #]?: '
                                      ), asDecimal, asHex, TRUE, gotSymbol) THEN
                IF (asDecimal >= 0) & (asDecimal < 100) & NOT gotSymbol THEN
                    ShowFields(GetRcvrAtLevel(asDecimal, pLink), TRUE)
                ELSE
                    ShowFields(TObject(asHex), TRUE);
            END

        ELSE IF theEventID = kLocals THEN
            BEGIN
            IF GetPromptedNumber(AtStr('Local variables of procedure [stack level #]?: '),
                                 asDecimal, asHex) THEN
                IF asDecimal <> - 1 THEN
                    ShowLocals(asDecimal, pLink);
            END

        ELSE IF theEventID = kMore THEN
            BEGIN
            IF pMoreMem = - 1 THEN
                WriteLn('There is no more to show.')
            ELSE
                ShowMemory(pMoreMem, 16);
            END

        ELSE IF theEventID = kMoreDisasm THEN
            BEGIN
{$IFC IncludeDisassembler}
            IF pMoreMem = - 1 THEN
                WriteLn('There is no more to show.')
            ELSE
                ShowDisasmMemory(pMoreMem, 16);
{$EndC}
            END

        ELSE IF theEventID = kParameters THEN
            BEGIN
            IF GetPromptedNumber(AtStr('Parameters of procedure [stack level #]?: '), asDecimal,
                                 asHex) THEN
                IF asDecimal <> - 1 THEN
                    ShowParameters(asDecimal, pLink);
            END

        ELSE IF theEventID = kRecentPC THEN
            ShowRecent

        ELSE IF theEventID = kStack THEN
            BEGIN
            nextLevel := 0;
            nextFrame := pLink;
            pNextPC := ppc;
            ShowStack;
            END

        ELSE IF theEventID = kSignalFailure THEN
            BEGIN
            { Get ready to blow out of debugger ### move this out to the outside of AE }
            IF GetPromptedNumber(AtStr('Error to signal with Failure?: '), asDecimal, asHex) THEN
                BEGIN
                error := asDecimal;
                IF GetPromptedNumber(AtStr('Message to signal with Failure?: '), asDecimal,
                   asHex) THEN
                    BEGIN
                    errMessage := asDecimal;
                    gReportNext := FALSE;

                    { Blow }
                    Failure(error, errMessage);
                    END;
                END;
            END

        ELSE IF theEventID = kSetBreak THEN
            SetBreakCmd

        ELSE IF theEventID = kClearBreak THEN
            ClrBreakCmd

        ELSE IF theEventID = kHeapCmd THEN
            HeapCmd

        ELSE IF theEventID = kPerfCommand THEN
            BEGIN
{$Ifc qPerform}
            PerfCmd
{$Endc}
            END

        ELSE IF theEventID = kFlags THEN
            FlagCmd;

    DebuggerDispatch := NoErr;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE NubWaitNextEvent;

    VAR
        theEvent:             EventRecord;
        event:                TToolBoxEvent;

    BEGIN
    { Yield and get commands from debugger }
    IF WaitNextEvent(everyEvent, theEvent, kMaxIdleTime, GetGrayRgn) THEN
        BEGIN
        CASE theEvent.what OF
            kHighLevelEvent:
                FailOSErr(AEProcessAppleEvent(theEvent));
            OTHERWISE
                IF YouAreWarned & IsFrontProcess THEN
                    BEGIN
                    New(event);
                    event.IToolBoxEvent(NIL);
                    event.HaveEvent(theEvent);
                    event.Process;
                    END;
        END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE MADebuggerMainEntry(aWhyInDebugger: WhyInDebugger; aPLink, aPpc: Longint);

    VAR
        i: INTEGER;
        forgotSuccess: BOOLEAN;
        aWho: MAName;
        pc: Longint;
        anERec: EventRecord;

        theMessage:         AEDesc;
        theReply:            AEDesc;


    BEGIN
    IF NOT pCanEnterDebugger THEN { debugger is not re-entrant. But give user a fighting chance }
        DebugStr('Re-entering the non re-entrant MacApp debugger. Proceed with care!')
    ELSE
        pCanEnterDebugger := FALSE;

    { make the reason we're here available to other procs }
    gWhyInDebugger := aWhyInDebugger;
    pLink := aPLink;
    ppc := aPpc;

    pRecentIndex := BAND(pRecentIndex + 1, kRecent); { modulo kRecent }
    WITH pRecentPC[pRecentIndex] DO
        BEGIN
        thePC := LongIntPtr(ppc)^;
        theWhyInDebugger := gWhyInDebugger;
        END;

    IF gMastReport THEN
        CheckFreeMasters
    ELSE
        pMasters := - 1;

    stkBreak := (gWhyInDebugger = tBegin) & ((pStackSpace > pBreakStack) | (pProcStack >
                pBrProcStack));
    stepBreak := (pStackSpace <= pStepOverStackSize); { stop only if stack is same or less for
                                                       single stepping }

    IF pBreakCount > 0 THEN
        BEGIN
        GetProcName(ppc, className, procName);
        IF length(className) > 0 THEN
            Delete(procName, 1, length(className) + 1);

        FOR i := 1 TO pBreakCount DO
            BEGIN
            pAtBreak := ((length(pBreakClass[i]) = 0) | (pBreakClass[i] = className)) & (
                        (length(pBreakProc[i]) <> 0) & (pBreakProc[i] = procName));
            IF pAtBreak THEN
                LEAVE;
            END;
        END
    ELSE
        pAtBreak := stkBreak | stepBreak;

    pStoppedInDebugger := gSingleStep | pAtBreak | (gWhyInDebugger >= tProgBreak) | IsUserBreak;

    { Check to see if we have too few calls to Success when leaving a procedure. This might be
    the case if the user forgot to make the call or it was missed and the handler is on the stack,
    which it usually (??? always) is. }
    forgotSuccess := ((gWhyInDebugger = tEnd) | (gWhyInDebugger = tExit)) & (gTopHandler <> NIL) &
                     (LongIntPtr(pLink)^ >= Longint(gTopHandler));
    IF forgotSuccess THEN
        BEGIN
        WriteLn(
           'You''re leaving a routine without calling Success for a handler that will be destroyed.'
                );
        pc := longint(gTopHandler^.exceptionHandler);
        GetMethodName(Longint(@pc), aWho);
        WriteLn('Failure handler is: ', aWho);
        pStoppedInDebugger := TRUE;
        END;

    IF gTracing | gReportNext | pStoppedInDebugger THEN
        BEGIN
        IF gReportNext & (length(gReportInfo) <> 0) THEN
            BEGIN
            WriteLn(gReportInfo);
            gReportInfo := '';
            END;

        IF TrcEnable(TRUE) THEN;

        IF NOT pStoppedInDebugger & gReportTime THEN
            Write(TickCount: 10, ': ');

        IF pAtBreak THEN
            BEGIN
            IF stkBreak THEN
                Write('(stack space) ');
            Write('broke at ');
            END
        ELSE IF gReportNext THEN
            Write('@ ')
        ELSE IF pStoppedInDebugger THEN
            Write('stopped at ');

        GetFrameInfo(pLink, ppc, callerFrame, itsFrame, receiver, className, procName, rcvrHandle,
                     rcvrClass, segNum);

        ShowWhyInDebugger(gWhyInDebugger, procName, segNum);
        IF ord(receiver) > 0 THEN
            Write('  Self: ', rcvrHandle, ' is ', rcvrClass);
        WriteLn;


        IF pStoppedInDebugger THEN
            BEGIN
            { notify debugger that we're stopping }
            { Create the basic message to send }
            FailOSErr(AECreateAppleEvent('MADB', kEnteredDebugger, NubGetDebuggerAddress,
                                         kAutoGenerateReturnID, kAnyTransactionID, theMessage));

            { Send it off, and don't worry about a reply or receipt }
            FailOSErr(AESend(theMessage, theReply, kAENoReply, kAENormalPriority, 1000, NIL, NIL));

            FailOSErr(AEDisposeDesc(theMessage));


{###SRF         if FALSE & (pEnterProc <> NIL) THEN
                CallEnter(TRUE, pEnterProc);}

            {$Ifc qPerform}
            oldState := DebugPerfMonitor(FALSE);
            {$Endc}

            WithHideFromMacAppDo(DoFullStop, FullHide);

{###SRF         if FALSE & (pEnterProc <> NIL) THEN
                CallEnter(FALSE, pEnterProc);}

            {$Ifc qPerform}
            IF DebugPerfMonitor(oldState) THEN;
            {$Endc}
            END
        ELSE IF EventAvail(everyEvent, anERec) THEN; { share time so tracing shows up }

        END;

    gReportNext := FALSE;

    pCanEnterDebugger := TRUE;

    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_BP;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        IF pStackSpace > gMaxStackDepth THEN
            gMaxStackDepth := pStackSpace;

        pProcStack := LongIntPtr(GetCurStackFramePtr)^ - Longint(GetCurStackFramePtr) - 8;

        MADebuggerMainEntry(tBegin, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_EP;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        MADebuggerMainEntry(tEnd, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S Main}
{$Push} {$Z+} {$%+}

PROCEDURE %_EX;

    VAR
        OldA5:                Longint;

    BEGIN
    OldA5 := SetCurrentA5;
    IF pCanEnterDebugger THEN
        BEGIN
        pStackSpace := ord(GetCurStackBase) - ord(GetCurStackTop);
        MADebuggerMainEntry(tExit, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);
        END;
    OldA5 := SetA5(OldA5);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE EnterMacAppDebugger;                            { called by ProgramBreak in UOBJECT }

    VAR
        notADummy:            Longint;

    BEGIN
    notADummy := LongIntPtr(Ord4(GetCurStackFramePtr))^; { they called ProgramBreak called
                                                          EnterMacAppDebugger: skip a level }
    MADebuggerMainEntry(tProgBreak, notADummy, notADummy + 4);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$Push} {$Z+}

FUNCTION GetErrTxt(errorCode: INTEGER): Str255;

    BEGIN
    GetIndString(GetErrTxt, 252, errorCode);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}
{$Push} {$Z+}

VAR
    e:                    Str255;

PROCEDURE DebugException(errorCode: INTEGER);
{ 68000 exceptions (code 901-910) and SysError calls }

    CONST
        kUnInitStorage1     = $72677267;                { Pascal provided uninited storage }
        kUnInitStorage2     = $67726772;                { odd byte boundary of above }
        kDebugHandleInit    = $F3F3F3F3;                { Handles are inited to this in MacApp® }
        kDebugPtrInit        = $F5F5F5F5;                { Pointers are inited to this in MacApp® }
        kDebugObjInit        = $F1F1F1F1;                { Objects are inited to this in MacApp® }

    VAR
        notADummy:            Longint;
        accessAddr:         Longint;
        extras:             INTEGER;
        OldA5:                Longint;
        oldResLoad:        BOOLEAN;
        oldResFile:        INTEGER;

    BEGIN
    OldA5 := SetCurrentA5;
    oldResLoad := GetResLoad;
    SetResLoad(TRUE);
    oldResFile := MAUseResFile(gApplicationRefNum);

    notADummy := ord(@notADummy) + 78;                    { Where to leave continuation address =
                                                         dummy4+link4+pc4+arg2+16*reg4 }
    LongIntPtr(notADummy)^ := pSysErrPatch.oldTrapAddr; { Tentative value (worst case & disk
                                                         inserts) }

    IF (errorCode = - 127) |                            { Old menu not found. }
       (errorCode = - 126) |                            { Old menu bar not found. }
       (errorCode = 30) |                                { "Please insert the disk". }
       ((errorCode >= 50) & (errorCode <= 69)) |        { SADE }
       ((errorCode >= $7FF0) & (errorCode <= $7FFF))    { Reserved for system or app use. }
       THEN
        BEGIN
        { Drop through }
        END
    ELSE
        BEGIN
        IF NOT pCanEnterDebugger THEN
            DebugStr(
                'Re-entering the non re-entrant MacApp debugger ON AN EXCEPTION. Proceed with care!'
                     );

        { If an exception happens in the exception handler, give up! }
        InstallExceptionHandlers(FALSE);

        EmptyHandle(pReserve);                            { we need all the space we can get }

        WriteLn;

        extras := 0;
        accessAddr := 0;
        IF (errorCode DIV 100) = 9 THEN                 { 900-9xx are 68000 exceptions, not SysErr
                                                         calls }
            BEGIN
            { Where to go after this procedure returns }
            CASE (errorCode - 900) * sizeof(Longint) OF
                exBusError:
                    Handle(notADummy)^ := pOldexBusError;
                exAddressError:
                    Handle(notADummy)^ := pOldexAddressError;
                exIllegalInst:
                    Handle(notADummy)^ := pOldexIllegalInst;
                exZeroDivide:
                    Handle(notADummy)^ := pOldexZeroDivide;
                exCheck:
                    Handle(notADummy)^ := pOldexCheck;
                exOverflow:
                    Handle(notADummy)^ := pOldexOverflow;
                exLineF:
                    Handle(notADummy)^ := pOldexLineF;
            END;

            IF errorCode = 900 THEN
                Write('NMI Button: ')
            ELSE
                Write('Exception #', errorCode - 900: 1, '  ');
            errorCode := errorCode - 901;
            { Thanks to Rob Hawley for improvements to the following code }
            IF (errorCode = 1) | (errorCode = 2) | (errorCode = 3) | (errorCode = 6) THEN { Bus
                   error or Address error }
                BEGIN
                { 68000 and 68020 have different exception stack frames }
                IF NOT (qNeedsMC68020 | qNeedsMC68030) & (gConfiguration.processor =
                   gestalt68000) THEN
                    BEGIN
                    extras := 8;                        { 68000 precedes status and PC with 4 words
                                                         }
                    accessAddr := LongIntPtr(notADummy + 6)^; { which includes the access address }
                    END
                ELSE
                    BEGIN
                    extras := 0;                        { no extra stack frame data before status
                                                         reg & PC }
                    wrlblptr('exception frame Addr', LongIntPtr(notADummy + 4));
                    WriteLn;
                    IF (errorCode = 1) | (errorCode = 2) THEN
                        BEGIN
                        wrlblptr('PC', LongIntPtr(notADummy + 4 + 2)^);
                        WriteLn;
                        accessAddr := LongIntPtr(notADummy + 20)^; { Must add 16 - 4 to get
                                                                    offending address}
                        END
                    ELSE
                        accessAddr := LongIntPtr(notADummy + 4 + 2)^; {Same as PC}
                    END
                END
            END
        ELSE
            Write('SysErr ID = ', errorCode: 1, '  ');

        CASE errorCode OF                                { All SysError argument values except where
                                                         indicated }
            0..28:
                e := GetErrTxt(errorCode + 1);
            33:
                e := GetErrTxt(30);
            { 30, 31: ...Disk insert... }
            41:
                e := GetErrTxt(31);
            42:
                e := GetErrTxt(32);
            51:
                e := GetErrTxt(33);
            81:
                e := GetErrTxt(34);
            84:
                e := GetErrTxt(35);
            85:
                e := GetErrTxt(36);
            86:
                e := GetErrTxt(37);
            100:
                e := GetErrTxt(38);
            MAXINT:
                e := GetErrTxt(39);
            OTHERWISE
                IF (32 <= errorCode) & (errorCode <= 53) THEN
                    e := GetErrTxt(40)
                ELSE
                    e := GetErrTxt(41);
        END;

        WriteLn(e);
        IF accessAddr <> 0 THEN
            BEGIN
            Write('Bad address was: ');
            WritePtr(accessAddr);
            WriteLn;
            IF accessAddr = kUnInitStorage1 THEN
                WriteLn('Appears to be Pascal provided uninitialized storage.')
            ELSE IF accessAddr = kUnInitStorage2 THEN
                WriteLn(
                      'Appears to be Pascal provided uninitialized storage at an odd byte boundary.'
                        )
            ELSE IF accessAddr = kDebugHandleInit THEN
                WriteLn('Appears to be Handle contents initialized by debugging.')
            ELSE IF accessAddr = kDebugPtrInit THEN
                WriteLn('Appears to be Pointer contents initialized by debugging.')
            ELSE IF accessAddr = kDebugObjInit THEN
                WriteLn('Appears to be uninitialized instance variable.')
            END;
{###SRF        gApplication.Beep(30);    }                        { 1/2 second }

        MADebuggerMainEntry(tSysError, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) +
                            2 + extras);
{###SRF                InstallExceptionHandlers(TRUE);}
        END;
    IF MAUseResFile(oldResFile) = 0 THEN;
    SetResLoad(oldResLoad);
    OldA5 := SetA5(OldA5);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$S MADebugger}

PROCEDURE aVBLTask;

    CONST
        kVBLDelay            = 15;                        { Ticks before checking }
        theOffset            = sizeof(Longint) * 2;

    VAR
        aKeyMap:            KeyMap;
        oldState:            INTEGER;

    BEGIN

{ Set up application's A5.
  Our A5 is prepended to the QElem which is pointed at by A0 }

    WITH pVBLInfo DO
        pVBLInfo.aQElemWithA5.OldA5 := SetA5(VBLInfoPtr(GetParmBlockPtr - theOffset)^.aQElemWithA5.
                                             A5);

    oldState := IntegerPtr(JournalFlag)^;
    IntegerPtr(JournalFlag)^ := 0;                        { turn off journaling }
    GetKeys(aKeyMap);
    IntegerPtr(JournalFlag)^ := oldState;

    IF aKeyMap[59] & aKeyMap[55] & aKeyMap[56] & aKeyMap[58] & pCanEnterDebugger THEN
        MADebuggerMainEntry(tVBL, Ord4(GetCurStackFramePtr), Ord4(GetCurStackFramePtr) + 4);

    { always Reset the vblCount }
    WITH pVBLInfo DO
        BEGIN
        aQElemWithA5.q.vblQElem.vblCount := kVBLDelay;
        IF SetA5(aQElemWithA5.OldA5) = 0 THEN;            { discard the function result }
        END;

    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAInit}

PROCEDURE VBLInstall;

    CONST
        kVBLDelay            = 15;                        { Ticks before checking }

    BEGIN
    IF pInterceptExceptionVectors THEN
        WITH pVBLInfo DO
            BEGIN
            { Setup the VBL task }
            WITH aQElemWithA5.q.vblQElem DO
                BEGIN
                qType := ord(vType);
                vblAddr := @aVBLTask;
                vblCount := kVBLDelay;
                vblPhase := 0;
                END;
            aQElemWithA5.A5 := Longint(GetA5);
            { This will make the A5 world available to the VBL task }

            { Install the VBL task }
            FailOSErr(VInstall(@aQElemWithA5.q));
            END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE VBLRemove;

{ removes the VBL task }

    VAR
        e:                    OSErr;

    BEGIN
    IF pInterceptExceptionVectors THEN
        e := VRemove(@pVBLInfo.aQElemWithA5.q);         { Discard error }
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugEndForce;

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugForceOutput(DebugToWindow, DebugToFile: DebugForceOptions);

    BEGIN
    END;

PROCEDURE InitUDebugAfterIApplication;
{ Call this once at the end of IApplication to finish initialization of the debugger. }

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

PROCEDURE DebugShowTranscriptWindow;
{ Call this proc from MacApp to show the window }

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION DebugCapture(captureProc: ProcPtr): ProcPtr;
{ Install an alternative capture proc, which will get called for every
writeln. It should have the same interface as AddText. You will
probably want to set gWrToWindow to FALSE to inhibit output to the
window at the same time. Pass NIL to remove any capture proc. }

    BEGIN
    DebugCapture := fCaptureProc;
    fCaptureProc := captureProc;
    END;

{$EndC qDebug}
{--------------------------------------------------------------------------------------------------}
{$S Main}

FUNCTION DebugCanReadLn: BOOLEAN;
{ Returns True if you can readln to the user }

    BEGIN
    DebugCanReadLn := pUDebugInitialized;
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

FUNCTION DebugCanWriteLn: BOOLEAN;
{ Returns True if you can writeln to the user }

    BEGIN
    DebugCanWriteLn := pUDebugInitialized;
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetCallersMethodName(VAR s: MAName);

    BEGIN
    GetMethodName(LongIntPtr(GetCurStackFramePtr)^ + 4, s); { report about our caller's caller }
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetMethodName(ppc: Longint; VAR s: MAName);
{ GetMethodName returns the name of the method (or procedure) in
which ppc points. }

    BEGIN
    GetProcName(ppc, discardStr, s);
    END;

{--------------------------------------------------------------------------------------------------}
{$S Main}

PROCEDURE GetProcName(ppc: Longint; VAR className, procName: MAName);
{ GetProcName returns the name of the procedure or function in
which ppc points.  If it is in a method, then it return's
the name of the method's class in className. }

    VAR
        pc, nextPC, limit:    Ptr;
        index:                INTEGER;

    BEGIN
    pc := Handle(ppc)^;
    IF (ord(pc) <> 0) & NOT Odd(ord(pc)) THEN
        BEGIN
        limit := Ptr(ord(pc) + 32767);
        WHILE (endOfModule(pc, limit, @procName, nextPC) = NIL) DO
            BEGIN
            IF ord(pc) >= ord(limit) THEN
                BEGIN
                className := '';
                procName := '';
                LEAVE;
                END
            ELSE
                pc := Ptr(ord(pc) + 2);
            END;

        index := pos('.', procName);
        IF index <> 0 THEN
            BEGIN
            className := copy(procName, 1, index - 1);
            END
        ELSE
            className := '';
        END
    ELSE
        BEGIN
        className := '';
        procName := '';
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebugger}

FUNCTION TrcEnable(okToTrace: BOOLEAN): BOOLEAN;
{ Control whether tracing from %_BP/%_EP/%_EX is enabled or not.  Set to false when the section
of code that you are using doesn't really need to be traced (like the inspector or debugger itself).}

    BEGIN
    TrcEnable := pTraceEnabled;
    pTraceEnabled := okToTrace;
    gTracing := pTraceToggle & pTraceEnabled;
    END;